Hyperlinks in Tabelle auf Funktionsfähigkeit prüfe
16.06.2015 09:38:19
Gordon
Ich möchte Hyperlinks auf Funktionsfähigkeit testen und bei false rot markieren.
Leider funktioniert das mit dem Makro, welches ich nutzen möchte nicht ganz.
Mit VBA habe ich mich erst seit drei Tagen, aufgrund dieses Problems, beschäftigt. Daher habe ich nicht wirklich viel Hintergrundwissen.
Hier ein Bild von meiner Tabelle (die ist natürlich viel größer, dient nur als Beispiel) und dem Entwicklerfenster daneben.
Was muss ich anpassen, damit es funktioniert?
Bild: http://abload.de/img/hyperlink6euym.jpg
Option Explicit
Option Compare Text
Sub hyperlinksTesten()
Dim HyperL As Hyperlink, Addresse As String, rng As Range, fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each HyperL In ActiveSheet.Hyperlinks
If Not HyperL.Address Like "*\*" Then
Addresse = ActiveWorkbook.Path & "\" & HyperL.Address
Else
Addresse = HyperL.Address
End If
If Not fso.FolderExists(Addresse) And Not fso.FileExists(Addresse) Then
With HyperL
Set rng = HyperL.Range
.Range.Value = "ERROR: " & Addresse
.Delete
rng.Font.ColorIndex = 3
End With
End If
Next
Set fso = Nothing
End Sub
Über Hilfe würde ich mich sehr freuen!
Gruß,
Gordon