' Repariert die beim Kopieren beschdigten Hyperlinks zum direkten Abspielen von Mediendateien

Public Sub HyperlinksReparieren()
    Dim objBlatt As Worksheet
    Dim objHyperlink As Hyperlink
    
    'Alle Bltter der aktuellen Mappe durchlaufen
    For Each objBlatt In ActiveWorkbook.Sheets
        'Wenn Blattname nicht "bersicht" lautet, dann...
        If objBlatt.Name <> "bersicht" Then
            '... alle Hyperlinks des Blatts durchlaufen
            For Each objHyperlink In objBlatt.Hyperlinks
                'Wenn Hyperlink einen Backslash enthlt, dann...
                If InStr(objHyperlink.Name, "\") Then
                    '... Name- in Address-Eigenschaft kopieren
                    objHyperlink.Address = objHyperlink.Name
                End If
            Next
        End If
    Next
End Sub