BIKIN DAFTAR ISI WORKBOOK EXCEL - Belajar Microsoft Excel : Tips, Tricks & Tutorial

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

11 Comments

Jika sOdara menemukan sesuatu yang bermanpaat di marih .... silahkan kasih komennya

This site uses Akismet to reduce spam. Learn how your comment data is processed.