Modification de liens hypertexte ---RESOLU--- Merci job75

[sylkro]

Bonjour, j'ai trouvé des topics existant sur le forum vis à vis de ma question, mais ils n'ont pas trouvé réponses, et date de quelques années.

Je souhaiterai via une macro sous Excel, modifier une partie de tous mes liens hypertexte, suite à un changement de dossier. J'ai environs plus de 1000 lignes à modifier, contenant parfois plus de 3 liens, je suis donc contraint de passer par une macro.

J'ai recréé des dossiers tests et un petit xls pour faciliter les choses, avec seulement 3 lignes. Voilà une image présentant le nouveau dossier des mes fichiers à gauche, et a droite l'ancien lien hypertexte, que je veux changer.



Donc je souhaiterai que ma macro, édite tous mes hypertextes, en allant chercher dans la cellule A, pour chaque cellule B, tout d'abord les 4 première lettres, puis toute la valeur, de sorte à ce que l'hypertexte :

AncienDossier\Demos\Demo1.txt

Devienne :
Test\Test001\Demo1.txt


Donc là où je bloque c'est dans le fait d'aller chercher tout ou partie de la valeur d'une cellule, pour modifier un lien hypertexte.

Pour ceux qui souhaiterait m'aider plus en profondeur, j'ai joins à ce message l'archive où j'ai créé mes dossiers de tests, et mon xls.


J'espère que ce que je souhaite est réalisable, et grand merci à ceux qui pourront, si ce n'est m'aider, me mettre sur la voie !

 

[JBOBO]

Re : Modification de liens hypertexte

Bonjour,

Pas sur de mon coup mais peut-etre en C1 de ton exemple :

LIEN_HYPERTEXTE(GAUCHE(A1;4)&"\"&A1&"\Demo"&CNUM(DROITE(A1;3))&".txt";B1)

 

[sylkro]

Re : Modification de liens hypertexte

C'est pas mal, merci de prendre du temps pour m'aider ! Mais ce n'est pas exactement ce que je recherche.

Ici ça m'oblige a créer de nouvelles cases, alors que mon tableau original est bien construit et mis en forme, de plus si dans mon exemple les noms des fichiers et des dossiers ne changent pas, ce n'est pas le cas dans mes vrais dossiers.

Donc le "Demo" et le ".txt"dans ta formule me pose problème, parce que mettons que j'ai un DemoVersion3.pdf dans mon exemple, ça ne fonctionne plus, et si je dois modifier la formule pour tous mes noms de fichiers ce serai beaucoup trop long.

J'ai modifier mon archive en prenant en compte cette contrainte ci-dessous :

Donc toute la problématique est de changer le corps du lien, sans la terminaison qui est le fichier, en se basant comme je l'ai expliqué dans mon précédent post, sur les cellules A.

Merci beaucoup en tout cas.

 

[JBOBO]

Re : Modification de liens hypertexte

re,

Je pense avoir compris ta demande, malheureusement, je ne vois pas comment faire pour le moment ! Plus le tps de regarder pour l'instant mais si je trouve , je poste.
Bon courage !

 

[job75]

Re : Modification de liens hypertexte

Bonsoir sylkro, JBOBO,

Après avoir téléchargé l'ensemble des dossiers et fichiers, ouvrez le fichier TestMacro.

Placez y cette macro (où vous voulez) :

Sub ChangeHyperlinks()
Dim h As Hyperlink, ad$, txt$
For Each h In ActiveSheet.Columns("B").Hyperlinks
  ad = h.Address
  txt = h.Parent.Offset(, -1) & "\"
  If txt Like "Test*" Then
    ad = Replace(ad, "AncienDossier", "Test")
    ad = Replace(ad, "Demos\", txt)
  ElseIf txt Like "Docu*" Then
    ad = Replace(ad, "AncienDossier", "Docu")
    ad = Replace(ad, "Doc\", txt)
  End If
  h.Parent.Hyperlinks.Add h.Parent, ad
Next
End Sub

Elle modifie les liens hypertextes de la colonne B de la feuille active (Feuil1).

Edit : je joins quand même le fichier avec la macro (Alt+F11).

A+

 

[sylkro]

Re : Modification de liens hypertexte

Merci beaucoup job75, on touche au but, mais j'ai encore une dernière contrainte !

J'ai adapté ta macro à mes dossiers originaux, et je me suis rendu compte, que j'ai plusieurs sous dossiers, commençant par la même lettre, puis une série de chiffres différente.

J'ai réadapté le excel de test, et modifié ta macro comme suit :

Sub ChangeHyperlinks()
Dim h As Hyperlink, ad$, txt$
For Each h In ActiveSheet.Columns("I").Hyperlinks
  ad = h.Address
  txt = h.Parent.Offset(, -8) & "\"
  If txt Like "Test*" Then
    ad = Replace(ad, "AncienDossier", "Test")
    ad = Replace(ad, "Demos\", txt)
  ElseIf txt Like "Docu*" Then
    ad = Replace(ad, "AncienDossier", "Docu")
    ad = Replace(ad, "Doc\", txt)
  ElseIf txt Like "CAZ*" Then
    ad = Replace(ad, "AncienDossier", "CAZ")
    ad = Replace(ad, "C*", txt) <===== Ligne posant problème
  End If
  h.Parent.Hyperlinks.Add h.Parent, ad
Next
End Sub

Dans mon archive ci-dessous, j'ai rajouté un dossier pour illustrer ma nouvelle contrainte. La macro fonctionne très bien lorsque je déclare clairement le sous dossier "C453" ou "C536", à la place de "C*". Mais j'ai parfois plus de 20 sous dossiers de ce type, ce que j'aimerai donc c'est comme j'ai mis plus haut, avoir un système de "C*", pour qu'ils prennent automatiquement en compte tous les dossiers commençant par C.

Mais quand j’exécute la macro sous cette forme, ça ne fonctionne pas.

Merci beaucoup en tout cas, ta macro fonctionne très bien, si on peut résoudre cette problématique de dossiers, ce sera parfait.

 

[job75]

Re : Modification de liens hypertexte

Bonjour sylkro,

On ne peut pas utiliser ici le caractère générique *.

Il faut déterminer le texte dos à remplacer, utilisez cette macro :

Sub ChangeHyperlinks()
Dim h As Hyperlink, ad$, txt$, dos$
For Each h In ActiveSheet.Columns("I").Hyperlinks
  ad = h.Address
  txt = h.Parent.Offset(, -8) & "/"
  If txt Like "Test*" Then
    ad = Replace(ad, "AncienDossier", "Test")
    ad = Replace(ad, "Demos/", txt)
  ElseIf txt Like "Docu*" Then
    ad = Replace(ad, "AncienDossier", "Docu")
    ad = Replace(ad, "Doc/", txt)
  ElseIf txt Like "CAZ*" Then
    ad = Replace(ad, "AncienDossier", "CAZ")
    dos = Mid(ad, 5, InStrRev(ad, "/") - 4) '5 = Len("CAZ") + 2
    ad = Replace(ad, dos, txt)
  End If
  h.Parent.Hyperlinks.Add h.Parent, ad
Next
End Sub

Et je me suis aperçu qu'il faut utiliser des "/" et non pas des "\"

Cela viendrait-il de la conversion de votre fichier .xlsm en .xls ?

Pas testé la macro sur .xlsm, si nécessaire il faudra voir avec des "\".

Fichier joint.

A+

 

[job75]

Re : Modification de liens hypertexte

Re,

J'ai voulu en avoir le coeur net et j'ai testé, sur Excel 2003 et Excel 2010, tous les fichiers avec :

ad = h.Address
MsgBox ad

L'inversion des slash "\" en "/" a lieu uniquement quand sur Excel 2003 on convertit un fichier .xlsm en .xls (c'est le cas du post #7).

Utilisez donc le fichier (2) joint où se trouvent les 2 fichiers .xlsm et .xls, le fichier .xls ayant été créé sur Excel 2010.

Sur les 2 fichiers la macro utilise les "\" :

Sub ChangeHyperlinks()
Dim h As Hyperlink, ad$, txt$, dos$
For Each h In ActiveSheet.Columns("I").Hyperlinks
  ad = h.Address
  txt = h.Parent.Offset(, -8) & "\"
  If txt Like "Test*" Then
    ad = Replace(ad, "AncienDossier", "Test")
    ad = Replace(ad, "Demos\", txt)
  ElseIf txt Like "Docu*" Then
    ad = Replace(ad, "AncienDossier", "Docu")
    ad = Replace(ad, "Doc\", txt)
  ElseIf txt Like "CAZ*" Then
    ad = Replace(ad, "AncienDossier", "CAZ")
    dos = Mid(ad, 5, InStrRev(ad, "\") - 4) '5 = Len("CAZ") + 2
    ad = Replace(ad, dos, txt)
  End If
  h.Parent.Hyperlinks.Add h.Parent, ad
Next
End Sub

Merci sylkro de nous avoir permis de découvrir ce phénomène d'inversion.

A+

 

[sylkro]

Re : Modification de liens hypertexte

Oui c'est bon à savoir.

En tout cas merci beaucoup, je suis entrain d'adapter la base de la macro à tous mes dossiers concernés, pour l'instant ça semble fonctionner, j'ai juste une autre petite question.

Il arrive que certains liens soient erronés, du coup quand je lance la macro, s'il y a un mauvais lien présent dans la colonne elle ne se lance pas, je dois m'amuser à le chercher et a le supprimer (Comme dit précédemment je peux avoir des colonnes avec plusieurs centaines de lignes...)

Serait-il possible de mettre une option pour que lorsqu'un lien de la colonne ne répond pas aux critères, on l'ignore, et on le change de couleur par exemple. Ce qui permettrait de bien faire la modification pour les autres, et de pouvoir retrouver le lien qui pose problème plus facilement.

J'en demande peut être beaucoup, mais vraiment merci déjà pour le code que tu m'as fourni.

 

[job75]

Re : Modification de liens hypertexte

Re,

Il suffit de tester la présence du texte à remplacer avec Instr.

Pas de test évidemment avec dos, puisque dos est touours là...

Si le texte à remplacer n'est pas présent, on colore la cellule du lien (en jaune).

Attention, si on lance 2 fois la macro, toutes les cellules seront colorées...

Sub ChangeHyperlinks()
Dim h As Hyperlink, ad$, txt$, dos$
For Each h In ActiveSheet.Columns("I").Hyperlinks
  ad = h.Address
  txt = h.Parent.Offset(, -8) & "\"
  If txt Like "Test*" Then
    If InStr(ad, "AncienDossier") Then _
      ad = Replace(ad, "AncienDossier", "Test") Else Coul h.Parent: GoTo 1
    If InStr(ad, "Demos\") Then _
      ad = Replace(ad, "Demos\", txt) Else Coul h.Parent: GoTo 1
  ElseIf txt Like "Docu*" Then
    If InStr(ad, "AncienDossier") Then _
      ad = Replace(ad, "AncienDossier", "Docu") Else Coul h.Parent: GoTo 1
    If InStr(ad, "Doc\") Then _
      ad = Replace(ad, "Doc\", txt) Else Coul h.Parent: GoTo 1
  ElseIf txt Like "CAZ*" Then
    If InStr(ad, "AncienDossier") Then _
      ad = Replace(ad, "AncienDossier", "CAZ") Else Coul h.Parent: GoTo 1
    dos = Mid(ad, 5, InStrRev(ad, "\") - 4) '5 = Len("CAZ") + 2
    ad = Replace(ad, dos, txt)
  End If
  h.Parent.Hyperlinks.Add h.Parent, ad
1 Next
End Sub

Sub Coul(cel As Range)
cel.Interior.ColorIndex = 6 'couleur jaune
End Sub

A+

 

[job75]

Re : Modification de liens hypertexte

Bonjour sylkro, le forum,

On peut préférer ceci :

Sub ChangeHyperlinks()
Dim h As Hyperlink, ad$, txt$, dos$
For Each h In ActiveSheet.Columns("I").Hyperlinks
  ad = h.Address
  txt = h.Parent.Offset(, -8) & "\"
  If txt Like "Test*" Then
    If InStr(ad, "AncienDossier") * InStr(ad, "Demos\") = 0 Then GoTo 1
    ad = Replace(ad, "AncienDossier", "Test")
    ad = Replace(ad, "Demos\", txt)
  ElseIf txt Like "Docu*" Then
    If InStr(ad, "AncienDossier") * InStr(ad, "Doc\") = 0 Then GoTo 1
    ad = Replace(ad, "AncienDossier", "Docu")
    ad = Replace(ad, "Doc\", txt)
  ElseIf txt Like "CAZ*" Then
    If InStr(ad, "AncienDossier") = 0 Then GoTo 1
    ad = Replace(ad, "AncienDossier", "CAZ")
    dos = Mid(ad, 5, InStrRev(ad, "\") - 4) '5 = Len("CAZ") + 2
    ad = Replace(ad, dos, txt)
  End If
  GoTo 2
1 h.Parent.Interior.ColorIndex = 6 'couleur jaune
2 h.Parent.Hyperlinks.Add h.Parent, ad
Next
End Sub

A+

 

[sylkro]

Re : Modification de liens hypertexte

Un grand merci a toi job75, j'ai pu décliner ton script pour toutes mes situations, il est très flexible, et grâce à la prise en compte des erreurs ça me permet de trouver rapidement si des lignes posent problème !

 

[mlem47]

Re : Modification de liens hypertexte ---RESOLU--- Merci job75

Bonjour,
je viens de lire avec intéret vos messages sur le traitement des liens hypertextes.
Je ne suis sans doute pas capable d'être aussi performant dans l'application des explications données.
Mon problème, moi, se situe uniquement à l'adresse du disque dur externe auquel fait référence ma formule.
J'ai bien essayé de changer le nom (la lettre) de mon hdd externe mais la lettre qu'il portait sur mon installation précédente n'est pas disponible sur ce pc ci.

voici l'ancien lien que j'avais :
F:\Ma Bibliothèque Musiques\2004-Compile\11 Free - Steeve Wonder.mp3

et le nouveau que j'aimerais avoir :
G:\Ma Bibliothèque Musiques\2004-Compile\11 Free - Steeve Wonder.mp3

J'ai près de 1000 adresses à changer et même si je suis retraité, j'aimerais trouver un moyen moins fastidieux que de les modifier une par une.

Je travaille sur Excel2007 sous Win7

Alors merci d'avance à qui pourra m'aider...

 

[job75]

Re : Modification de liens hypertexte ---RESOLU--- Merci job75

Bonjour mlem47, bienvenue sur XLD,

Il aurait été mieux de créer votre propre discussion.

La solution est très simple :

Sub ModifierLien()
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
h.Address = "G" & Mid(h.Address, 2)
Next
End Sub

Activer la feuille avec les liens et lancer la macro.

Tous les liens seront modifiés, mais si l'on veut se limiter à une plage :

Sub ModifierLienPlage()
Dim h As Hyperlink
For Each h In [A1:A1000].Hyperlinks
h.Address = "G" & Mid(h.Address, 2)
Next
End Sub

A+

 

[mlem47]

Re : Modification de liens hypertexte ---RESOLU--- Merci job75

Un tout grand merci.
Je n'ai pas encore tester le lien mais la lettre est changée il n'y aura donc pas de souci.
Passez une excellente journée