Discussion :

[youbewt]

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:

Code vb :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
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 donné sur cette page dans une autre macro en lui disant de colorer en rouge les cellules dont les liens hypertextes ne sont pas valides:

Code vb :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
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 s'il vous plait?

Merci.

[Docmarti]

Le problème ne vient sûrement pas des %20 qui remplacent les espaces.
Car c'est la façon normale de représenter les espaces dans les URL.

Il faut chercher le problème ailleurs.

[youbewt]

Merci Docmarti.

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.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
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.

[Docmarti]

Si les liens ne sont plus en bleu, c'est que les liens n'existent plus.

La réponse qui me vient, c'est pourquoi tu permets à cette macro de remplacer le contenu des cellules qui contiennent des liens hypertextes que tu sembles vouloir conserver. C'est au niveau de cette macro qu'il faut agir. Ou bien, si ce n'est pas possible, créer une nouvelle macro qui recrée les liens hypertextes.

[Philippe Tulliez]

Bonjour,
Si j'ai bien compris tes liens hypertextes font référence à des fichiers se trouvant sur un disque.
Il est donc inutile d'utiliser l'adresse du lien comme tu le fais dans cette instruction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cible = Cellule.Hyperlinks(1).Address

un simple Cible = Cellule.Value ou Cible = Cellule (la propriété Value étant la propriété par défaut) suffit.
Ce test permet de visualiser que nous avons bien l'adresse complète.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim sht As Worksheet, rng As Range
Set sht = ThisWorkbook.Worksheets("Feuil1")
For Each rng In sht.Range("B3:B8")
 If Len(rng) Then Debug.Print Dir(rng.Hyperlinks(1).Address)
Next

Pour tester l'existence d'un fichier nous pouvons utiliser une fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Function IsFileExist(FileName As String) As Boolean
 IsFileExist = (Dir(FileName) <> "")
End Function

Donc pour colorer en rouge les liens non valides

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub Test()
 Dim sht As Worksheet, rng As Range
 Set sht = ThisWorkbook.Worksheets("Feuil1")
 For Each rng In sht.Range("B3:B8")
  With rng
   If Len(.Value) Then
    If IsFileExist(.Value) Then .Interior.Color = vbWhite Else .Interior.Color = vbRed
   End If
  End With
 Next
End Sub

Et si l'on veut s'affranchir de l'appel à la fonction IsFileExist, on remplace la ligne 7 par celle-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If (Dir(.Value) <> "") Then .Interior.Color = vbWhite Else .Interior.Color = vbRed

[youbewt]

Si les liens ne sont plus en bleu, c'est que les liens n'existent plus.

La réponse qui me vient, c'est pourquoi tu permets à cette macro de remplacer le contenu des cellules qui contiennent des liens hypertextes que tu sembles vouloir conserver. C'est au niveau de cette macro qu'il faut agir. Ou bien, si ce n'est pas possible, créer une nouvelle macro qui recrée les liens hypertextes.

Non c'est tout l'inverse, ce que je voudrais c'est ne plus toucher aux cellules qui contiennent un lien hypertexte et je voudrais éviter de devoir recréer a chaque fois les liens hypertexte pour un gain de temps. Effectivement si je test les liens, immédiatement après avoir créé les liens (donc sans exécuter d'autres macro entre temps) le test fonctionne correctement.


Merci Philippe Tulliez, j'ai testé les codes que tu m'as donné en les adaptant à mon problème:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub control()
 
Dim sht As Worksheet, rng As Range
Set sht = ThisWorkbook.Worksheets("Liste films")
For Each rng In sht.Range("A2:A4")
    With rng
         If Len(.Value) Then
            If (Dir(.Value) <> "") Then
                .Interior.Color = vbWhite
            Else: .Interior.Color = vbRed
            End If
         End If
    End With
Next
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub visualiser()
 
Dim sht As Worksheet, rng As Range
Set sht = ThisWorkbook.Worksheets("Liste films")
For Each rng In sht.Range("A2:A4")
 If Len(rng) Then Debug.Print Dir(rng.Hyperlinks(1).Address)
Next
 
End Sub

Mais le problème est le même, même les lien hypertextes valides sont colorés, et cette fois même si je recrée les liens juste avant. Et le test "visualiser" ne renvoi rien.

[Philippe Tulliez]

Bonjour,
C'est très curieux car je teste toujours les codes avant de les publier et chez moi cela s'est très bien déroulé.
Tes liens hypertextes sont bien des fichiers se trouvant sur ton disque dur ?

[Docmarti]

Non c'est tout l'inverse, ce que je voudrais c'est ne plus toucher aux cellules qui contiennent un lien hypertexte et je voudrais éviter de devoir recréer a chaque fois les liens hypertexte pour un gain de temps. Effectivement si je test les liens, immédiatement après avoir créé les liens (donc sans exécuter d'autres macro entre temps) le test fonctionne correctement.

Donc il faut bien identifier la macro qui crée le problème et qui t'oblige à recréer les liens hypertextes. Et envoie-nous le code de cette macro qu'il faut modifier, améliorer, adapter à tes besoins.