BIKIN DAFTAR ISI WORKBOOK EXCEL
Berapa jumlah sheet sOdara dalam satu file Workbook Excel ❓ … jawabnya pasti beragam ada yang sedikit ada pula yang banyak … kalO jumlahnya sedikit pasti ndak terlalu masalah dengan navigasi sheetnya … sOdara bisa lompat sana lompat sini dengan sekali ceKlik nama sheetnya pada TabSheet … tapi kalo jumlahnya buanyak tentunya bakalan bikin repot dalam navigasinya … daftar sheet yang nongol di TabSheet excel sOdara bakalan puanjang mengular kayak gerbong kereta pas lebaran 🙂
Solusinyanya gimana … kita bisa buWat daptar isi dari WorkBook tersebOt … yaah mirip2 daptar isi buku lah … daptar isi ini dibuWat pada satu sheet khusus … dalam sheet ini semuWa sheet yang ada dalam WorkBook akan dibuWat HYPERLINKnya … sehingga sOdara dapat memilih sheet dengan cukup ceKlik HYPERLINKnya saja … untuk bikin HYPERLINK sangat mudah tinggal klik kanan pada suatu cell lalu akan muncul formnya … atau mau pakai fungsi HYPERLINK juga bisa
Masalahnya jika workbook yang akan kita buWat daptar isinya terdiri atas buanyak sheet … bisa buonyok dengan menggunakan cara diatas …. hmmmm 🙄 cukup merepotkan apalagi ada banyak workbook yang harus kita buWat daptar isinya 😯 … solusinya gimana ❓ … yaaaggghh kita harus agak sedikit repot diawalnya karena harus bikin macro (ndak usah kuatir saya bikinin :smile:)
Menggunakan macro ini sOdara cukup ceKlik menu “Buat ‘Daptar Isi’” … workbook sOdara pun akan bertambah 1 sheet baru yaitu sheet “Daptar Isi” … daptar isi ada 3 kolom
- kolom 1 Nomor urut
- Kolom 2 Nama Sheet … ini yang ada HYPERLINKnya
- Kolom 3 Uraian … berisi penjelasan mengenai sheet tersebut … isinya sama dengan isi range A1 dan B1 sheet kolom 2 … kalO mau diganti silahkan aja … bisa diganti dengan range selain A1 pada kodenya … gampang kok
kalO sOdara ceKlik nama sheet pada kolom 2 …. sssssssssssttttttttt … langsung melesat ke sheet yang di maksud …. trus kalo mau balik tinggal ceKlik “Ke ‘DaptarIsi” … dan sssssssssssssssstttttt … sOdara sudah balik lage ke sheet Daptar Isi 🙂
berikOt penampakan skrinsyutnya
ini kode yang dipakE
'========================================================================= ' diboewat oleh MUHAMMAD SYUKRON ' http://excellerates.com/ '========================================================================= Option Explicit Sub Daptar_Isi() Dim Ws As Worksheet Dim BarisKe, WsKe As Integer Dim TempUraian1, TempUraian2 As String Dim ResponTimpa As VbMsgBoxResult Const Ura1 = "A1", Ura2 = "B1" 'silahkan diganti sesuai yang kebutuhan With ActiveWorkbook On Error GoTo DiDeL .Worksheets("Daptar Isi").Activate On Error GoTo 0 ResponTimpa = MsgBox("sHeeT DapTar IsI sudaH adA" & vbCrLf _ & vbCrLf & "BuaT baRU ???", vbQuestion + vbYesNo, _ ActiveWorkbook.Name) If ResponTimpa = vbYes Then With Application .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual End With .Worksheets("Daptar Isi").Delete DiDeL: .Worksheets.Add(Before:=.Worksheets(1)).Name = "Daptar Isi" Else Exit Sub End If End With With ActiveWorkbook.Sheets("Daptar Isi") .Activate .Range("A1").Value = "No." .Range("B1").Value = "Nama Sheet" .Range("C1").Value = "Cell " & Ura1 & Chr(32) & Chr(124) _ & Chr(32) & Ura2 End With BarisKe = 2 WsKe = 0 For Each Ws In ActiveWorkbook.Worksheets If Ws.Name <> ActiveSheet.Name Then With ActiveSheet .Cells(BarisKe, 1).Value = BarisKe - 1 .Hyperlinks.Add .Cells(BarisKe, 2), "", _ SubAddress:="'" & Ws.Name & "'!A1", _ TextToDisplay:=Ws.Name TempUraian1 = Sheets(Ws.Name).Range(Ura1).Value If Len(TempUraian1) > 50 Then TempUraian1 = _ Left(TempUraian1, 50) & "..." If TempUraian1 = Empty Then TempUraian1 = "[#kosong#]" TempUraian2 = Sheets(Ws.Name).Range(Ura2).Value If Len(TempUraian2) > 50 Then TempUraian2 = _ Left(TempUraian2, 50) & "..." If TempUraian2 = Empty Then TempUraian2 = "[#kosong#]" .Cells(BarisKe, 3).Value = TempUraian1 & Chr(32) & _ Chr(124) & Chr(32) & TempUraian2 End With BarisKe = BarisKe + 1 WsKe = WsKe + 1 End If Next With ActiveWorkbook.Sheets("Daptar Isi").Range("A1:C1") .Font.Bold = True .Interior.ColorIndex = 1 .Font.ColorIndex = 2 End With ActiveSheet.Columns("A:C").EntireColumn.AutoFit ActiveWorkbook.Sheets("Daptar Isi").Cells(BarisKe + 2, 1).Value = _ "dibikin pada : " & Format(Now(), "dd mmmm yyyy hh:mm") With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlAutomatic End With End Sub '========================================================================= Sub Ke_Daptar_Isi() Dim ResponBikin As VbMsgBoxResult On Error GoTo errDI ActiveWorkbook.Sheets("Daptar Isi").Activate Exit Sub errDI: ResponBikin = MsgBox("sHeeT 'DapTar IsI' belUm adA" & vbCrLf & _ vbCrLf & "BuaT baRU ???", vbQuestion + vbYesNo, _ ActiveWorkbook.Name) If ResponBikin = vbYes Then Daptar_Isi Else Exit Sub End If End Sub '========================================================================= Sub Auto_Close() On Error Resume Next Application.CommandBars("Worksheet Menu Bar"). _ Controls("Daptar Isi").Delete End Sub '========================================================================= Sub Auto_Open() Dim menuDI, subBuat, subKe Auto_Close Set menuDI = CommandBars("Worksheet Menu Bar").Controls.Add _ (Type:=msoControlPopup, Temporary:=True) menuDI.Caption = "Daptar Isi" menuDI.BeginGroup = True Set subBuat = menuDI.CommandBar.Controls _ .Add(Type:=msoControlButton, ID:=1) With subBuat .Caption = "Buat 'Daptar Isi'" .TooltipText = "Klik untuk membuat sheet 'Daptar Isi'" .Style = msoButtonCaption .OnAction = "Daptar_Isi" End With Set subKe = menuDI.CommandBar.Controls _ .Add(Type:=msoControlButton, ID:=1) With subKe .Caption = "Ke 'Daptar Isi'" .TooltipText = "Klik untuk menuju ke sheet 'Daptar Isi'" .Style = msoButtonCaption .OnAction = "Ke_Daptar_Isi" End With End Sub
format file yang bisa sOdara donloth dalam bentuk .xls kalO mau dibikin add in tinggal di save as aja … judul filenya DaptarIsi.xls 😉
semoga manpaat dan MDLMDL 🙂 🙂 🙂
bingung cara downloadnya ??Baca aja halaman download dengan klik icon di samping |
feed , email and my social media![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() |
Alhamdulillah…… ada solusi meringankan pekerjaan. Mengelola data siswa 24 kelas. Makasih mas Sukron.
OK pak Guru 🙂
add in yang menarik dan oke.
Blog ini sungguh banyak memberikan inspirasi bagi saya.
Berbekal banyak hal yang saya dapat dari blog ini, saya belajar membuat blog tentang excel walaupun saya masih sangat awam tentang excel. Namun, keinginan untuk berbagi membawa saya untuk mengelola blog:
http://www.excelheru.blogspot.com
Siiip pak 🙂
wah saya baru tertarik kembali belajar excel… semoga apa yang ada di blog ini bisa menambah ilmu saya…
thanks mas.. update terus ya… artikel excel… nya
thanks balik
waduh saya masih kurang paham cara nya neh. saya coba2 gak bisa-bisa mas. gmna ya
bisa lebih spesifik ndak bisanya gimana ?
bagus banget blognya. saya jadi bisa belajar banyak lagi dunk. thx yoo
thx balik 😉
mantap gan