Tester les liens hypertextes

Bonjour,

je voudrais créer une macro qui vérifierai si les liens hypertexte contenus dans les cellules d'une colonne sont valides.

Une première macro ajoute les liens hypertextes aux cellules qui contiennent déjà du texte:

For j = 1 To n
     ch1 = Sheets("Liste films").Cells(8 + j, 9).Value
     ch2 = Sheets("Liste films").Cells(8 + j, 1).Value
     chlien = ch1 & ch2
     Sheets("Liste films").Cells(8 + j, 1).Select
     Selection.Hyperlinks.Add Anchor:=Selection, Address:=chlien
Next j

Pour contrôler les lien hypertextes je me suis servi du code suivant dans une autre macro en lui disant de colorer en rouge les cellules dont les liens hypertextes ne sont pas valides:

Sub check_hypertexte()

For k = 1 To n
    If VerifHyperlink(Cells(8 + k, 1)) = False Then
       Sheets("Liste films").Cells(8 + k, 1).Interior.Color = vbRed
    End If
Next k

End Sub

Le souci est que lorsque j’exécute cette macro, elle me colore des cellules même si le lien hypertexte qu'elles contiennent fonctionne correctement.

En fait certains liens renvoient à des fichiers présents sur le PC et d'autre vers des fichiers présents sur un disque dur externe et je remarque que le problème a lieu pour les fichiers du PC.

D'ailleurs lorsque je fais clic droit sur une cellule rouge puis "modifier lien hypertexte", l'adresse du lien contient des "%20" à la place des espaces, ce qui n'est pas le cas des fichiers du disque dur.

Donc je me dis que l'erreur vient de là mais je ne vois pas comment résoudre le problème.

Pourriez-vous m'aider.

Merci.

Bonsoir,

Sans certitudes avec un Replace mais il vaut mieux éviter les espaces dans les noms de fichiers si vous souhaitez les manipuler.

    Sub check_hypertexte()

    For k = 1 To n
        If VerifHyperlink(replace(Cells(8 + k, 1)," ","%20")) = False Then
           Sheets("Liste films").Cells(8 + k, 1).Interior.Color = vbRed
        End If
    Next k

    End Sub

Cdt,

Darzou

Merci Darzou.

En fait j'ai fait le test avec des fichiers sans espaces, le problème reste le même.

En fait les cellules sont colorées en rouge des que les liens hypertextes perdent leur couleur bleu, donc a chaque fois que la feuille est modifiée, par exemple après l’exécution d'une autre macro.

J'ai donc créé une nouvelle fonction VerifHyperlink2 qui renvoi dans une cellule le résultat de "Dir(Cible)" utilisé dans la fonction VerifHyperlink qui teste la validité des liens hypertextes.

Function VerifHyperlink(Cellule As Range) As Boolean
    Dim Cible As String

    'Vérifie si la cellule contient un lien hypertexte
    If Cellule.Hyperlinks.Count = 0 Then
        VerifHyperlink = False
        Exit Function
    End If

    'Extrait l'adresse du lien
    Cible = Cellule.Hyperlinks(1).Address

    'Vérifie si le fichier existe.
    '(Ne fonctionne pas pour les liens web).
    If Dir(Cible) <> "" And Cible <> "" Then
        VerifHyperlink = True
    Else
        VerifHyperlink = False
    End If

End Function

Function VerifHyperlink2(Cellule As Range) As String
    Dim Cible As String

    'Vérifie si la cellule contient un lien hypertexte
    If Cellule.Hyperlinks.Count = 0 Then
        VerifHyperlink2 = False
        Exit Function
    End If

    'Extrait l'adresse du lien
    Cible = Cellule.Hyperlinks(1).Address

    'Vérifie si le fichier existe.
    '(Ne fonctionne pas pour les liens web).
    If Dir(Cible) <> "" And Cible <> "" Then
        VerifHyperlink2 = Dir(Cible)
        Else
        VerifHyperlink2 = Dir(Cible)
    End If

End Function

For k = 1 To n
    If VerifHyperlink(Cells(1 + k, 1)) = False Then
       Sheets("Liste films").Cells(1 + k, 1).Interior.Color = vbRed
       Sheets("Liste films").Cells(1 + k, 4) = VerifHyperlink2(Cells(1 + k, 1))
    Else
       Sheets("Liste films").Cells(1 + k, 4) = VerifHyperlink2(Cells(1 + k, 1))
    End If
Next k

Lorsque les liens sont encore en bleu soulignés, le test VerifHyperlink est positif (cellule non colorée en rouge) et la cellule contient le nom du fichier cible. Par contre quand les liens ne sont plus en bleus , le test VerifHyperlink est négatif (cellule colorée en rouge) et la cellule est vide, ce qui explique le résultat négatif de VerifHyperlink.

Donc le souci viendrait du fait que même si le lien hypertexte existe et est correcte, le résultat de "Dir(Cible)" est vide.

Maintenant je ne vois toujours pas comment remédier à ce problème.