Détecter des liens hypertextes morts

[MeMa]

Bonjour,

Je me tourne vers vous après avoir épluché quelques articles qui ne m'ont malheureusement pas aidé...
J'ai notamment utilisé cette discussion et un des codes sur ce forum. Mais je suis toujours coincée. J'aimerai pouvoir utiliser une macro qui permet de détecter des liens morts. Je suis en pleine mise à jour de documents qui contienne une petite centaine de liens hypertextes, c'est relativement fastidieux de les ouvrir un à un pour les vérifier. J'utilise ce code:

Private Sub CommandButton1_Click()
    Dim hl As Hyperlink
    For Each hl In ActiveSheet.Hyperlinks
        On Error Resume Next
        ActiveWorkbook.FollowHyperlink hl.Address
        If Err.Number <> 0 Then
            MsgBox "Erreur" & hl.Address
            Err.Clear
        End If
    Next hl
End Sub

Qui ouvre un a un tout les documents associés aux hyperliens autrement dit absolument pas pratique quand on voit le nombre de documents liés. Je voulais savoir s'il y avait un moyen de ne pas ouvrir un à un chaque document? Mais également s'il y avait la possibilité de mettre en évidence les liens morts autrement que par une MsgBox, en changeant la couleur de fond de la cellule par exemple?


Merci d'avance pour toute l'aide que vous pourrez fournir, et bonne journée!

 

[MeMa]

En fouillant sur les sites anglophones je suis tombée sur ce code:

    Dim alink As Hyperlink
    Dim StrURL As String
    For Each alink In ActiveSheet.Cells.Hyperlinks
        StrURL = alink.Address
        If Dir(StrURL) = "" Then
            alink.Parent.Interior.Color = 255
        End If
    Next alink

appartenant à ce fil.

Ça fonctionne parfaitement bien pour moi.
Bonne soirée et bon courage.

 

[Hasco]

Bonjour,

Merci pour ce retour qui sera certainement utile à de futurs demandeur. De plus il est 100% dans l'esprit de partage du forum que beaucoup oublient.

Bonne continuation

 

[omr]

bonjour à tous
je voudrais savoir s'il est possible de l'appliquer au classeur en entier. j'ai essayer de changer activesheet en thisworkbook mais ça paraissait trop facile.
merci d'avance

 

[Hasco]

Bonjour,

En rajoutant une variable feuille et une boucle pour parcourir toutes les feuilles du classeur :

 Dim alink As Hyperlink
    Dim StrURL As String
    Dim ws As Worksheet ' Feuille en cours de traitement dans la boucle
    '
    ' Parcourir toutes les feuilles du classeur
    For Each ws In ThisWorkbook
        For Each alink In ws.Cells.Hyperlinks
            StrURL = alink.Address
            If Dir(StrURL) = "" Then
                alink.Parent.Interior.Color = 255
            End If
        Next alink
    Next

cordialement