Skip to the content

Hoe maak ik een inhoudsopgave in Excel VBA

In Microsoft Word heb je de standaard mogelijkheid om een inhoudsopgave te maken. Deze mogelijkheid bestaat niet in Excel.

Bij grote Excel bestanden met veel tabbladen kan het erg handig zijn om een inhoudspagina toe te voegen. Met de onderstaande code kun je in VBA dit automatiseren en de inhoudsopgave automatisch bij laten werken.

Heb je hulp nodig bij dit onderwerp? Neem dan contact op met onze helpdesk, we helpen je graag op weg.

De Code in VBA

Plak de onderstaande code in je VBA editor (ThisWorkbook of maak een module aan). Als je niet weet hoe je de VBA editor aan kunt roepen lees dan het blog: Een eigen functie maken in Excel.

Sub MaakEenInhoudTab()

    Dim ws As Worksheet
    Dim Content_ws As Variant
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim wsName1 As String
    Dim wsName2 As String
    Dim InhoudName As String
    Dim wsCount As Long
    Dim ColumnCount As Variant
    
    'Definieer de tekst die u wilt zien als koptekst van de inhoudsopgave
    
    InhoudName = "Inhoud"
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Activeer de inhoud tab als deze al bestaat
    
    On Error Resume Next
    
        Worksheets("Contents").Activate
    
    On Error GoTo 0
    
    If ActiveSheet.Name = InhoudName Then
    
        myAnswer = MsgBox("Het werkblad [" & InhoudName & "] bestaat al, Wilt u deze vervangen?", vbYesNo)
        
        If myAnswer <> vbYes Then GoTo ExitSub
        
        'Verwijder de inhoud tab als de gebruiker ja heeft gekozen
        
        Worksheets(InhoudName).Delete
    
    End If
    
    'Tel het aantal zichtbare tabbladen
    
    For Each ws In ActiveWorkbook.Worksheets
    
        If ws.Visible = True Then wsCount = wsCount + 1
    
    Next ws
    
    'Hoeveel kolommen moet de inhoud bevatten
    
    ColumnCount = Application.InputBox("U heeft " & wsCount & _
    " zichtbare werkbladen." & vbNewLine & "Hoeveel kolommen " & _
    "wilt u opnemen in de inhoud tab?", Type:=2)
    
    If TypeName(ColumnCount) = "Boolean" Or ColumnCount < 0 Then GoTo ExitSub
    
    'Maak een nieuwe inhoud tab aan voor de inhoudsopgave

    Worksheets.Add Before:=Worksheets(1)
    
    'Hernoem het nieuwe tabblad naar de inhoudnaam
    
    Set Content_ws = ActiveSheet
    
    Content_ws.Name = InhoudName
    
    'Maak een array met de namen van alle tabbladen uitgezonderd de inhoud
    
    ReDim myArray(1 To wsCount)
    
    For Each ws In ActiveWorkbook.Worksheets
    
        If ws.Name <> InhoudName And ws.Visible = True Then
        
        myArray(x + 1) = ws.Name
        
        x = x + 1
    
        End If

    Next ws

    'Sorteer de namen van de tabbladen op alfabetische volgorde
    
    For x = LBound(myArray) To UBound(myArray)
        For y = x To UBound(myArray)
        If UCase(myArray(y)) < UCase(myArray(x)) Then
            wsName1 = myArray(x)
            wsName2 = myArray(y)
            myArray(x) = wsName2
            myArray(y) = wsName1
        End If
        Next y
    Next x

    'Maak de nieuwe inhoud pagina aan
    
    x = 1
    
    For y = 1 To ColumnCount
    
        For z = 1 To WorksheetFunction.RoundUp(wsCount / ColumnCount, 0)
        
            If x <= UBound(myArray) Then
            
            Set ws = Worksheets(myArray(x))
            
            ws.Activate
            
            With Content_ws
            
            .Hyperlinks.Add .Cells(z + 2, 2 * y), "", _
            SubAddress:="'" & ws.Name & "'!A1", _
            TextToDisplay:=ws.Name
            
            End With
            
            x = x + 1
        
        End If
        
        Next z
    
    Next y

    Content_ws.Activate
    
    Content_ws.UsedRange.EntireColumn.AutoFit
    
    ActiveWindow.DisplayGridlines = False

    'Maak de titel van de inhoud
    
    With Content_ws.Range("B1")
    
    .Value = "Inhoud"
    
    .Font.Bold = True
    
    .Font.Size = 18
    
    End With
    
ExitSub:
    
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True

End Sub
DOWNLOAD HIER HET VOORBEELD BESTAND

De macro toevoegen aan een toetscombinatie

Nu de nieuwe sub is toegevoegd aan de VBA editor kun je deze aanroepen als macro met de macro-editor.

Dit doe je door de toetscombinatie ALT+F8 of door te klikken op de button [Macro] op het tabblad [Beeld]

Nu kun je de macro selecteren en klikken op uitvoeren waarna de inhoudsopgave wordt aangemaakt.

 

Reinder.eu | Macro starten in Excel

Om de macro toe te voegen aan een sneltoetscombinatie kies je voor [Opties] en voeg je de macro toe aan je eigen sneltoetscombinatie.

De VBA-code aan het werk

Als je op uitvoeren hebt geklikt dan wordt de VBA code aangeroepen. Als het tabblad inhoud nog niet bestaat zal de vraag verschijnen hoeveel kolommen je wilt gebruiken.

Deze vraag zal het aantal horizontale kolommen bepalen waarbinnen de inhoudsopgave zal worden opgemaakt. In onderstaand voorbeeld kiezen we 3 kolommen waarna de namen van de tabbladen worden verdeeld over 3 kolommen.

 

Reinder.eu | Aantal kolommen bepalen Excel