Hyperlinks in Tabelle auf Funktionsfähigkeit prüfe

Bild

Betrifft: Hyperlinks in Tabelle auf Funktionsfähigkeit prüfe
von: Gordon
Geschrieben am: 16.06.2015 09:38:19

Hallo Zusammen,
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

Bild

Betrifft: AW: Hyperlinks in Tabelle auf Funktionsfähigkeit prüfe
von: Michael
Geschrieben am: 16.06.2015 16:48:42
Hi Gordon,
versuch's mal damit:

Option Explicit
Option Compare Text
Sub hyperlinksTesten()
    Dim HyperL As Hyperlink, Addresse As String, t As String
    Dim fso As Object, rng As Range
    
    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
        ' Addresse = "blabla"
        If Not fso.FolderExists(Addresse) And Not fso.FileExists(Addresse) Then
          Set rng = HyperL.Range
          t = rng.Text
          HyperL.Delete
          rng.Value = "ERROR: " & t
          rng.Font.ColorIndex = 3
        End If
    Next
    Set fso = Nothing
End Sub
Die Zeile Addresse="blabla" hatte ich zum Testen eingefügt...
Gruß,
Michael

Bild

Betrifft: AW: Hyperlinks in Tabelle auf Funktionsfähigkeit prüfe
von: Gordon
Geschrieben am: 17.06.2015 10:07:05
Vielen Dank Michael! Funktioniert jetzt super.
PS: Falls jemand nur prüfen möchte, ob einzelne Arbeitsblätter bei einer Verlinkung noch vorhanden sind, der kann folgende Formel verwenden (Beispieldatei anbei):

=WENNFEHLER(INDIREKT(C6);"Error")

wobei in Celle C6 das verlinkte Arbeitsblatt zu finden ist.
Gruß,
Gordon

Bild

Betrifft: freut mich, danke für die Rückmeldung owT
von: Michael
Geschrieben am: 19.06.2015 12:16:59


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Hyperlinks in Tabelle auf Funktionsfähigkeit prüfe"