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