Skapa länklista för arbetsböcker
I detta tips visar hur vi kan skapa en länklista i ett arbetsblad för hela arbetsboken. Denna teknik kan användas t ex för dokumentation eller för att spåra fel.
Option Explicit
Sub Skapa_Lank_Lista()
'© 2002 Alla rättigheter XL-Dennis
Dim nNamn As Excel.Name
Dim rnOmrade As Range, rnCell As Range, rnArea As Range
Dim wsBlad As Worksheet
Dim stVal As String, stTitel As String
Dim lnCell As Long
stVal = "!"
lnCell = 1
With Application
.DisplayAlerts = False
.Application.ScreenUpdating = False
End With
On Error Resume Next
With ActiveWorkbook
.Sheets("Länklista").Delete
.Sheets.Add
End With
On Error GoTo 0
Application.DisplayAlerts = True
With ActiveSheet
.Name = "Länklista"
.Cells(1, 1).Formula = "Bladnamn:"
.Cells(1, 2).Formula = "Namn:"
.Cells(1, 3).Formula = "Cellreferens:"
.Cells(1, 4).Formula = "Länkformel:"
.Cells(1, 5).Formula = "Länkvärde:"
With Range("A1:E1")
.Font.Bold = True
.Font.ColorIndex = 10
.Font.Size = 11
End With
End With
'Här gås samtliga arbetsblad igenom där eventuella formler
'har referenser till andra blad eller annan arbetsbok dokumenteras.
For Each wsBlad In ActiveWorkbook.Worksheets
Set rnOmrade = Nothing
On Error Resume Next
Set rnOmrade = wsBlad.UsedRange.SpecialCells(xlFormulas)
On Error GoTo 0
If Not rnOmrade Is Nothing Then
For Each rnArea In rnOmrade.Areas
For Each rnCell In rnArea.Cells
If InStr(rnCell.Formula, stVal) Then
lnCell = lnCell + 1
With Worksheets("Länklista")
.Cells(lnCell, 1) = wsBlad.Name
.Cells(lnCell, 3) = _
rnCell.Address(RowAbsolute:=False, _
ColumnAbsolute:=False)
.Cells(lnCell, 4) = "'" & rnCell.Formula
On Error Resume Next
.Cells(lnCell, 5) = rnCell.Formula
End With
End If
Next rnCell
Next rnArea
End If
Next wsBlad
'Här gås samtliga eventuella konstanta namn i arbetsboken igenom och dokumenteras.
For Each nNamn In ActiveWorkbook.Names
lnCell = lnCell + 1
With Worksheets("Länklista")
.Cells(lnCell, 2) = nNamn.Name
.Cells(lnCell, 4) = "'" & nNamn.RefersTo
.Cells(lnCell, 5) = nNamn.Value
End With
Next nNamn
'Här gås samtliga eventuella namn som refererar till celler igenom och dokumenteras.
For Each wsBlad In ActiveWorkbook.Worksheets
Set rnOmrade = Nothing
On Error Resume Next
Set rnOmrade = wsBlad.UsedRange.SpecialCells(xlFormulas)
On Error GoTo 0
If Not rnOmrade Is Nothing Then
For Each rnArea In rnOmrade.Areas
For Each rnCell In rnArea.Cells
For Each nNamn In ActiveWorkbook.Names
If InStr(rnCell.Formula, nNamn.Name) Then
lnCell = lnCell + 1
With Worksheets("Länklista")
.Cells(lnCell, 1) = wsBlad.Name
.Cells(lnCell, 2) = nNamn.Name
.Cells(lnCell, 3) = _
rnCell.Address(RowAbsolute:=False, _
ColumnAbsolute:=False)
.Cells(lnCell, 4) = "'" & rnCell.Formula
.Cells(lnCell, 5) = rnCell.Formula
End With
End If
Next nNamn
Next rnCell
Next rnArea
End If
Next wsBlad
Columns("A:E").EntireColumn.AutoFit
ActiveWindow.Zoom = 75
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub