1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
| Sub ModifierTexteLienHypertexte()
Dim LigneTitre As Long
Dim DerniereLigne As Long
Dim Cellule As Range
LigneTitre = 1 ' A adapter suivant votre tableau
DerniereLigne = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
' Attention 1 suppose que la colonne 1 soit non vide
Range(Cells(LigneTitre + 1, 1), Cells(DerniereLigne, 1)).Select
' Les liens hypertextes se trouvent
' dans les cellules de la 1ère colonne
For Each Cellule In Selection
If Cellule.Hyperlinks.Count > 0 Then
Cellule.Hyperlinks(1).ScreenTip = Cellule.Offset(0, 1)
' Le contenu du texte se trouve dans la 1ère cellule
' après la cellule du lien hypertexte
End If
Next Cellule
End Sub |
Partager