Skapa innehållsförteckning för arbetsböcker

 

Här demonstreras en teknik för att skapa en innehållsförteckning i ett separat arbetsblad för arbetsböcker, där hyperlänkar underlättar navigeringen samt visar sidantalet löpande vid utskrift.

 

Option Explicit  

Sub Skapa_Innehallforteckning_Lankar_Antal_Sidor()

  '© 2005 Alla rättigheter XL-Dennis

  Dim wbBook As Workbook

  Dim wsActive As Worksheet, wsSheet As Worksheet

  Dim lnRow As Long, lnPages As Long, lnCount As Long, lnTotal As Long

 

  Set wbBook = ActiveWorkbook

 

  With Application

    .DisplayAlerts = False

    .ScreenUpdating = False

  End With

 

  'Om arbetsbladet redan existerar tas detta bort först innan det nya

  'arbetsbladet läggs till.

  On Error Resume Next

  With ActiveWorkbook

    .Worksheets("Innehållsförteckning").Delete

    .Worksheets.Add Before:=.Worksheets(1)

  End With

  On Error GoTo 0

 

  Set wsActive = wbBook.ActiveSheet

 

  'Preparerar arbetsbladet

  With wsActive

    .Name = "Innehållsförteckning"

    With .Range("A1:B1")

      .Value = VBA.Array("Innehållsförteckning", "Antal löpande sidor per blad")

      .Font.Bold = True

    End With

  End With

 

  lnRow = 2

  lnCount = 1

 

  'Loopar igenom samtliga arbetsblad, skapar bladnamn, lägger till hyperlänkar,

  'räknar och skriver ut det löpande sidantalet per arbetsblad.

   For Each wsSheet In wbBook.Worksheets

    If wsSheet.Name <> wsActive.Name Then

      wsSheet.Activate

      With wsActive

        .Hyperlinks.Add .Cells(lnRow, 1), "", _

            SubAddress:="'" & wsSheet.Name & "'!A1", _

            TextToDisplay:=wsSheet.Name

        lnPages = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")

        lnTotal = lnTotal + lnPages

        .Cells(lnRow, 2).Value = "'" & lnCount & "-" & lnTotal

      End With

      lnRow = lnRow + 1

      lnCount = lnTotal + 1

    End If

  Next wsSheet

 

  wsActive.Activate

  Columns("A:B").EntireColumn.AutoFit

 

  With Application

    .DisplayAlerts = True

    .ScreenUpdating = True

  End With

End Sub