Modifier format cellule si lien hypertexte vide
SpaceNoodles -
Bonjour,
Un collègue du boulot nous avait créé une petite macro afin de lier un n° d'ECP (dans la feuille) au document PDF de l'ECP (sur notre réseau). Voici le code ci-dessous:
Private Sub CommandButton7_Click() 'MàJ liens ECP
Dim dernligne As Integer
For dernligne = 6 To 1000
If Sheets("synthese").Cells(dernligne, 1) = "" Then Exit For
Next dernligne
dernligne = dernligne - 1
Dim ECP As String
'
For a = 6 To dernligne
Sheets("synthese").Cells(a, 1).Select
ECP = Sheets("synthese").Cells(a, 1).Value
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:= _
"Chemin réseau" & ECP & ".pdf", _
TextToDisplay:="" & ECP & ""
Next a
End Sub
J'ai remarqué que la macro créait des liens sur des ECP (dans la feuille) qui n'ont pas de fichier PDF a lier sur le réseau.
Ce que je souhaiterais c'est que lorsque la macro ne trouve pas de fichier correspondant, elle modifie le format de la cellule ou du texte afin de voir d'un coup d'oeil qu'il manque un document a lier.
Malgré mes quelques heures de recherche et essai (et surtout vu mon niveau en macro...) je ne trouve aucune solution, je me demande même si la problème ne vient pas de ma macro de base (ci-dessus). Alors je viens demander de l'aide !
D'avance, merci!
1 réponse
-
Bonjour,
essaie cela:
Sub test() Dim h As Hyperlink, MyFile For Each h In ActiveSheet.Hyperlinks MyFile = Dir(h.Address) If MyFile = "" Then MsgBox h.Name ' adresse du lien MsgBox ActiveCell.Address ' adresse de la cellule ActiveCell.Clear 'supprime le lien End If Next End Sub
-
Ca ressemble en effet a ce que je recherche merci beaucoup.
Si je souhaite que la cellule sans lien change de police / format plutôt que le contenu sois effacé de la cellule, il faut que je change la ligne "ActiveCell.Clear" ?
Edit: J'ai modifié par ActiveCell.Interior.Color = RGB(255, 0, 0), cependant ca passe la cellule qui est active quand je lance la macro, et non la cellule ou le lien hypertexte est mort.
-
comme ceci:
Sub test() Dim h As Hyperlink, MyFile For Each h In ActiveSheet.Hyperlinks MyFile = Dir(h.Address) If MyFile = "" Then Worksheets("Feuil1").Range("A1:A100").Find(What:=h.Address).Select 'plage à adapter ActiveCell.Clear 'supprime le lien ActiveCell.Interior.Color = RGB(255, 0, 0) End If Next End Subvoilà
@+
-
-
-
Oui, j'ai modifié le nom de la feuille au nom de la feuille a laquelle je voulais que ça s'applique, et la plage aussi
J'ai modifié le "Feuil1" par "synthese" (qui est le nom de ma feuille) et si la plage c'est bien le "Range" j'ai juste mis ("A6:A1000") ce qui correspond à mon tableau pour le moment
-
