Excel und VBA: Formeln, Programmierung, Lösungen

StandardModule: Modul1

Sub CheckHyperlinks()
    Dim itc As Inet
    Dim ws As Worksheet
    Dim hyp As Hyperlink

    Set itc = New Inet
    With itc
        .Protocol = icHTTP
        .RequestTimeout = 5
    End With
    On Error Resume Next
    For Each ws In ActiveWorkbook.Worksheets
        For Each hyp In ws.Hyperlinks
            If Len(itc.OpenURL(hyp.Address, icString)) Then
                hyp.Parent.Interior.ColorIndex = _
                 xlColorIndexNone
            Else
                hyp.Parent.Interior.ColorIndex = 3
            End If
        Next hyp
    Next ws
    On Error GoTo 0
    Set itc = Nothing
End Sub

    

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Hyperlink