Modifier liens hypertexte

[JL83]

Bonjour à tous,

J'utilise un fichier excel comme base de données documentaire afin de faciliter l'ouverture de spécifications techniques. Ce fichier contient des 100ène de liens vers des pdf et chaque ligne du tableau renvoie vers le document en question via un lien hypertexte. Ces documents sont stockés sur un serveur dans un dossier spécifique. Ce dossier spécifique contenant le fichier excel et tous les dossiers présents dans ce dossier ont été déplacés et donc les liens hypertextes ne sont plus bons.
Je souhaiterai développer une macro pour modifier tous mes liens afin de ne pas les modifier un par un avec clic droit, modifier le lien hypertexte, etc...
Seule une partie des liens n'est plus correct du fait du déplacement du dossier spécifique. Le reste du chemin pointant vers les fichiers reste identique.
J'ai recherché sur le forum avant de réaliser ce post et différents utilisateurs ont des problèmes similaires au miens.
J'ai essayé les solutions proposées en réponse en l'adaptant à mon cas mais sans succès.

https://www.excel-downloads.com/thr...te-automatiquement-nom-serveur-change.206916/

Je suis tombé sur le site de jacques boisgontier et une macro est proposée.
Les liens hyper-textes

Sub ModifieAddresse()
NvRepertoire = "c:\Mesdoc\ExcelMacroNouveau\1001exemples\"
For Each h In ActiveSheet.Hyperlinks
a = Split(Replace(h.Address, "\", "/"), "/")
nf = a(UBound(a))
h.Address = NvRepertoire & nf
Next h
End Sub

Cette macro remplace tout le chemin des liens. Je souhaiterai remplacer uniquement une partie du lien. Est-il possible de rajouter une condition a cette macro ?

En vous remerciant par avance de vos réponse.

 

[JL83]

Re : Modifier liens hypertexte

Help svp!!

 

[JL83]

Re : Modifier liens hypertexte

Bonjour,

Malgré le manque de réponse sur ce post 🙁🙁🙁, j'ai trouvé la solution à mon problème par un autre moyen.
Je vous donne quand même la solution pour les personnes intéressées pour clôturer le post :


Option Explicit

Sub macro()

Dim chemin_a_remplacer As String
Dim nouveau_chemin As String
Dim old_link As String
Dim old_text As String
Dim x As Range

chemin_a_remplacer = "xxxx" 'partie du chemin à remplacer
nouveau_chemin = "yyyyy" 'le nouveau chemin

For Each x In Selection.Cells

If x.Hyperlinks.Count > 0 Then
old_link = x.Hyperlinks(1).Address
old_text = x.Hyperlinks(1).TextToDisplay 'si nécessaire

x.Hyperlinks(1).Address = Replace(old_link, chemin_a_remplacer, nouveau_chemin)
x.Hyperlinks(1).TextToDisplay = Replace(old_text, chemin_a_remplacer, nouveau_chemin) 'si nécessaire

Else
End If
Next x


End Sub


Nota : faire attention caractères exact à indiquer dans les chemins (par ex : / au lieu de \ et %20 pour les espace).
Pour trouver le chemin existant EXACT dans: clique droit sur le lien --> modifier le lien.