AW: Hyperlinks in Formeln umwandeln
14.08.2013 12:22:24
Luschi
Hallo guebla,
da die Hyperlink-Formeln nicht in der Hyperlink-Auflistung der Arbeitsblätter aufgelistet sind, muß man per Find-Befehl die Zellen suchen, die eine solche Formel enthalten. In der extra anzulegenden Tabelle 'iniTab' werden 3 Angaben gelistet: Tabellenname, Zelladresse und Hyperlink-Formel.
Wenn Du die korrigierten Hyperlinks in der 4. Spalte erfaßt, kann man per Vba die Formeln auch wieder zurückschreiben.
Um Dir die Arbeit ein 2. mal zu ersparen, falls wieder Verzeichniswechsel anstehen, schreibe den Pfad in der 'iniTab' in eine Zelle und verknüpfe die neue Hyperlinkadresse mit dieser Zelle.
Dann mußt Du beim nächsten mal nur noch diesen Zellinhalt an den neuen Pfad anpassen. Denn _
gerade, wenn es sich um ein Netzlaufwerkpfad handelt ist man vor der Arbeitswut des Admins nicht geschützt.
Sub hypsSuchen()
Dim wb As Workbook, ws As Worksheet, _
rg1 As Range, rg2 As Range
Dim adr As String
Set wb = ThisWorkbook
'iniTtab ist eine separate/extra angelegte Tabelle
Set rg1 = ThisWorkbook.Worksheets("iniTab").Range("A4")
rg1.Value = "Tabelle"
rg1.Offset(0, 1).Value = "Zelle"
rg1.Offset(0, 2).Value = "Formel"
rg1.Resize(1, 3).Font.Bold = True
Set rg1 = rg1.Offset(1, 0)
For Each ws In wb.Worksheets
If ws.Name "iniTab" Then
'alle Zeilen & Spalten einblenden, da Find versteckte Zellen nicht findet!!!
ws.Cells.EntireRow.Hidden = False
ws.Cells.EntireColumn.Hidden = False
With ws.Cells
Set rg2 = .Find("=HYPERLINK(", , xlFormulas, xlPart, xlByColumns, xlNext, False, _
False, False)
If Not rg2 Is Nothing Then
adr = rg2.Address
Do
rg1.Value = rg2.Parent.Name
rg1.Offset(0, 1).Value = rg2.Address(0, 0)
rg1.Offset(0, 2).Value = "'" & rg2.FormulaLocal
Set rg2 = .FindNext(rg2)
Set rg1 = rg1.Offset(1, 0)
Loop While Not rg2 Is Nothing And rg2.Address adr
End If
End With
End If
Next ws
Set rg1 = Nothing
Set rg2 = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub
Gruß von Luschi
aus klein-Paris