"chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hypertexte

fox_mulder · 31 Juillet 2010

Bonjour,

J'ai un souci avec des liens hypertextes que je dois modifier ( qui survient à la suite de modification de répertoire ).
J'ai essayé de m'inspirer de la discussion :
https://www.excel-downloads.com/threads/modifier-adresses-de-liens-hypertexte.85941/

(ne sachant pas si la discussion de cet article est close ou non, j'ai tout de même posté mon problème à la suite de cet article, et dans le doute, j'ouvre une nouvelle discussion puisque le problème est légèrement différent).

Je n'arrive pas à adapter le code de cet article car pour mon cas, il s'agit d'une petite chaine de caractère qui se trouve au sein de la chaine de caractère du lien hypertexte, et non pas juste au début, et bien sûr, si la "chaine à rechercher" n'est pas trouvée, ne rien faire comme action.

De plus, mes liens ne sont pas attachés à des cellules mais à des "pictures" ou "images" qui en cliquant dessus (grâce au lien hypertexte) permettent d'ouvrir soit des dossiers soit des fichiers.

Comment peut-on faire pour réaliser ce que je désire ??😕

🙄 Ce que je voudrais c'est faire une procédure qui recherche "chaine à rechercher" et si elle est trouvée, remplacer par "chaine de remplacement" et ce dans tous les liens hypertextes affectés à des "images" ou "pictures".

En vous remerciant,

Fox
🙂

kjin · 31 Juillet 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonjour,
Pas regardé l'exemple en question

Code:

txt1 = "Ancien Texte"
txt2 = "Nouveau Texte"
For Each lnk In ActiveSheet.Hyperlinks
    If lnk.Address Like "*" & txt1 & "*" Then lnk.Address = Replace(lnk.Address, txt1, txt2)
Next

A+
kjin

fox_mulder · 31 Juillet 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

kjin à dit:
Bonjour,
Pas regardé l'exemple en question

Code:

txt1 = "Ancien Texte" txt2 = "Nouveau Texte" For Each lnk In ActiveSheet.Hyperlinks If lnk.Address Like "*" & txt1 & "*" Then lnk.Address = Replace(lnk.Address, txt1, txt2) Next

A+
kjin

Bonjour kjin

Merci beaucoup pour ton code, il fonctionne impec ...😀
🙄Pourrais-je te demander comment ton code est modifié si on veut qu'à la fin de la procédure, une fenêtre ( MsgBox ) affiche le nombre de remplacement qui a été effectué ?

En te remerciant,
Bonne continuation,

Fox 😉

kjin · 31 Juillet 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

re,
J'ai ajouter le contrôle pour déterminer si le lien est attaché à une forme et le compteur

Code:

txt1 = "Temp"
txt2 = "Srapbook"
For Each lnk In ActiveSheet.Hyperlinks
    If lnk.Type = 1 And InStr(lnk.Address, txt1) Then
        lnk.Address = Replace(lnk.Address, txt1, txt2)
        compteur = compteur + 1
    End If
Next
MsgBox compteur & " liens trouvés et modifiés"

A+
kjin

fox_mulder · 31 Juillet 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonsoir kjin

Merci beaucoup pour ton code.
Ca fonctionne.

Cependant j'ai voulu enjoliver le tout en créant un userforme qui à priori fonctionne (c'est mon tout premier userform) afin d'ouvrir une commande pour pouvoir demander la chaine de recherche (txt1) et la chaine de remplacement (txt2).

Ensuite, je voulais qu'il face la recherche et m'indique combien de lien il a trouvé contenant (txt1), et me demande de confirmer le remplacement par (txt2).

Puis enfin, un dernier message confirmant l'action de remplacement.

J'ai donc le code suivant :

Sub essai_chgt_lien()

txt1 = Range("B1").Value
txt2 = Range("C1").Value
compteur = 0
For Each lnk In ActiveSheet.Hyperlinks
If lnk.Type = 1 And InStr(lnk.Address, txt1) Then
lnk.Address = Replace(lnk.Address, txt1, txt1)
compteur = compteur + 1

End If
Next

Reponse = MsgBox(Prompt:="Il y a [ " & compteur & " ] liens hypertextes dans lesquels la chaine [ " & _
txt1 & " ] a été trouvé. Voulez-vous la remplacer par [ " & txt2 & " ]? ", Title:="Résultat de la recherche des liens hypertextes :", Buttons:=vbYesNo)

compteur = 0
If Reponse = Yes Then
For Each lnk In ActiveSheet.Hyperlinks
If lnk.Type = 1 And InStr(lnk.Address, txt1) Then
lnk.Address = Replace(lnk.Address, txt1, txt2)
compteur = compteur + 1
End If
Next

Reponse = MsgBox(Prompt:="Il y a [ " & compteur & " ] liens hypertextee dans lesquels la chaine [ " & _
txt1 & " ] a été trouvés puis remplacé par [ " & txt2 & " ].", Title:="Résultat du remplaçement des liens hypertextes :")
End If

Range("B1").Value = ""
Range("C1").Value = ""

End Sub

'code de mon bouton actionnant mon userform
Private Sub CommandButton1_Click()
UserForm1.Show
If Range("B1").Value <> "" Then
essai_chgt_lien
End If
End Sub

'code dans les bouton du userforme :
Private Sub CommandButton1_Click()
With Feuil5
.Range("B1").Value = TextBox1
.Range("C1").Value = TextBox2
End With
Unload Me
End Sub

Private Sub CommandButton2_Click()
Unload Me

End Sub

Voila, après tout ça , et bien ça ne fonctionne plus 🙁
Enfin le code se déroule mais il ne trouve plus de liens comportant txt1 (alors qu'il y en a ) ....

Si tu pouvais me dire ce qui cloche dans mon code ... s'il te plait ...🙄

En te remerciant,

Fox

kjin · 1 Août 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonsoir,
Deux bonnes habitudes à prendre :
- dans tes messages, mettre les lignes de code entre balises

Code:

 (# dans le menu)
- joindre un fichier simplifié surtout dans le cas de userform car même si je vois à peu près où est le pb, je ne sais pas, si tu récupères les données de la feuille pour alimenter les Textbox(es) ou l'inverse, ni à quoi servent les boutons
Donc vaiment au pif, en supposant que tu alimentes les Textbox(es) depuis B1 et C1, je te laisse adapter
[CODE]
Sub Essai_chgt_lien(txt1, txt2)
compteur = 0
For Each lnk In ActiveSheet.Hyperlinks 'est ce dans la feuille active ou non ?
    If lnk.Type = 1 And InStr(lnk.Address, txt1) Then
        compteur = compteur + 1
    End If
Next

Select Case compteur
Case 0
    MsgBox "Aucun lien ne comporte le mot """ & txt1 & """"
    Exit Sub
Case Else
    If MsgBox("Il y a " & compteur & " liens hypertextes dans lesquels la chaine """ & _
        txt1 & """ a été trouvé." & vbCrLf & "Voulez-vous la remplacer par """ & txt2 & """ ?", _
        vbYesNo, "Résultat de la recherche des liens hypertextes :") = vbYes Then
        compteur = 0
        For Each lnk In ActiveSheet.Hyperlinks
            If lnk.Type = 1 And InStr(lnk.Address, txt1) Then
                lnk.Address = Replace(lnk.Address, txt1, txt2)
                compteur = compteur + 1
            End If
        Next
        MsgBox "Il y a " & compteur & " liens hypertextee dans lesquels la chaine """ & _
            txt1 & """ a été trouvés puis remplacé par """ & txt2 & """."
    End If
End Select

End Sub

Private Sub CommandButton1_Click()
If TextBox1 = "" Or TextBox2 = "" Then Exit Sub
Essai_chgt_lien TextBox1, TextBox2

End Sub

Private Sub UserForm_Initialize()
With Sheets("Feuil5")
    TextBox1 = .Range("B1")
    TextBox2 = .Range("C1")
End With

End Sub

A+
kjin

fox_mulder · 1 Août 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonjour kjin

Tout d'abord merci pour tes modifications.
Je vais mettre en application tes conseils (je fais un essai 😉)

Code:

Sub Essai_chgt_lien(TextBox1, TextBox2)
compteur = 0
For Each lnk In ActiveSheet.Hyperlinks
    If lnk.Type = 1 And InStr(lnk.Address, TextBox1) Then
        compteur = compteur + 1
    End If
Next

Select Case compteur
Case 0
    MsgBox "Aucun lien ne comporte le mot """ & TextBox1 & """"
    Exit Sub
    
Case 1 'pour que le message soit au singulier
     If MsgBox("Il y a [ " & compteur & " ] lien hypertexte dans lequel la chaine """ & _
        TextBox1 & """ a été trouvé." & vbCrLf & "Voulez-vous la remplacer par """ & TextBox2 & """ ?", _
        vbYesNo, "Résultat de la recherche des liens hypertextes :") = vbYes Then
        compteur = 0
        For Each lnk In ActiveSheet.Hyperlinks
            If lnk.Type = 1 And InStr(lnk.Address, TextBox1) Then
                lnk.Address = Replace(lnk.Address, TextBox1, TextBox2)
                compteur = compteur + 1
            End If
        Next
         MsgBox "Il y a [ " & compteur & " ] lien hypertexte dans lequel la chaine """ & _
            TextBox1 & """ a été trouvé puis remplacé par """ & TextBox2 & """.", _
            vbOKOnly, "Résultat du remplacement des liens hypertextes :"
       
    End If
  
Case Else 'pour que compteur > 1 le message soit au pluriel
    If MsgBox("Il y a [ " & compteur & " ] liens hypertextes dans lesquels la chaine """ & _
        TextBox1 & """ a été trouvé." & vbCrLf & "Voulez-vous la remplacer par """ & TextBox2 & """ ?", _
        vbYesNo, "Résultat de la recherche des liens hypertextes :") = vbYes Then
        compteur = 0
        For Each lnk In ActiveSheet.Hyperlinks
            If lnk.Type = 1 And InStr(lnk.Address, TextBox1) Then
                lnk.Address = Replace(lnk.Address, TextBox1, TextBox2)
                compteur = compteur + 1
            End If
        Next
         MsgBox "Il y a [ " & compteur & " ] liens hypertextes dans lesquels la chaine """ & _
            TextBox1 & """ a été trouvé puis remplacé par """ & TextBox2 & """.", _
            vbOKOnly, "Résultat du remplacement des liens hypertextes :"
       

    End If
End Select

End Sub

Private Sub CommandButton1_Click()
If TextBox1 = "" Or TextBox2 = "" Then Exit Sub
Essai_chgt_lien TextBox1, TextBox2

End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
    TextBox1 = ""
    TextBox2 = ""

End Sub

Je l'ai mis en pièce jointe le fichier modifier.
Sinon, j'ai une petite question :
1- j'ai toujours mis "sub" dans la feuille où la "sub" se déroule. Toi , tu la mets dans un module à part, Quel est l'intérêt ?

2- quand on met le userforme en non modal, et que l'on a plusieurs userforme d'ouvert, comment fait-on pour les fermer tous d'un seul coup?

3- J'ai mis ce code dans mon fichier mais il ne trouve plus les liens de la chaine rechercher ( alors qu'il y en a ...! Y a surement qqc que j'ai omis ! mais quoi ?

Sinon, j'aurais d'autre question, mais la c'est pour des images à insérer dans un userforme (et dans des cellules déterminées) : est-ce possible de t'envoyer un message (pour me conseiller ; enfin je ne veux pas abuser ...😛) ou plutôt ouvrir un nouveau sujet ?

En te souhaitant une bonne fin de we,

Fox

PS : si préférence pour le vouvoiement , dit le moi.

kjin · 1 Août 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

fox_mulder à dit:
Code:

Case 1 'pour que le message soit au singulier

Tu pousses un peu non ?! lien(s) aurait suffit je pense, mais bon...

fox_mulder à dit:
j'ai toujours mis "sub" dans la feuille où la "sub" se déroule. Toi , tu la mets dans un module à part, Quel est l'intérêt ?

Cpearson l'a très bien décrit ICI, mais faut causer english

fox_mulder à dit:
Sinon, j'aurais d'autre question...ou plutôt ouvrir un nouveau sujet ?

Ouvre un nouveau fil, le forum est fait pour ça

fox_mulder à dit:
...si préférence pour le vouvoiement , dit le moi.

Je n'ai pas de préférence et je ne suis pas suceptible
A+
kjin

fox_mulder · 1 Août 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Rebonjour,
Ok pour tes remarques : je suis puriste lol

kjin à dit:
Tu pousses un peu non ?! lien(s) aurait suffit je pense, mais bon...
kjin

Sinon, ok je vais poster un nouveau sujet :

kjin à dit:
Ouvre un nouveau fil, le forum est fait pour ça
kjin

Ok, j'en prend note 😛

kjin à dit:
Je n'ai pas de préférence et je ne suis pas susceptible
A+
kjin

Sinon, j'étais en train de modifier mon message et je pense que tu n'as pas vu ma question 3 :

fox_mulder à dit:
3- J'ai mis ce code dans mon fichier mais il ne trouve plus les liens de la chaine rechercher ( alors qu'il y en a ...! Y a surement qqc que j'ai omis ! mais quoi ?
fox_mulder

J'ai regarder partout ça ne fonctionne plus quand je fais cela dans mon fichier initial.
C'est surement une erreur de débutant ....

A+
Fox

fox_mulder · 1 Août 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonsoir
Après une p'tit séance de ciné, je me suis remis sur le code et ça fonctionne ...
Donc merci kjin.
(je crois que j'avais mal écris la chaine que je recherchais ....lol)

A+

Fox

gb.bfp · 3 Novembre 2010

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonjour,

J'ai le même problème, mais avec le début du lien hypertexte qui est "masqué"...
Je m'explique, j'ai un tableau de traçabilité sur lequel j'enregistre l'ensemble des appareils fabriqués et j'enregistre pour chacun leurs interventions qui me renvoient vers un fichier pdf à l'aide d'un lien hypertexte nommé.

Seulement, j'ai transféré le fichier excel et les fichiers pdf mais le lien ne se fait plus car l'emplacement du fiichier lé au lien hypertexte n'est plus le même !
Comment puis-je faire.
Dans l'attente de votre aide.
Merci d'avance

le_nono31 · 19 Janvier 2011

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Manip bien pratique, merci pour le code.
Par contre sur Excel 2000 (au moins) il faut faire attention à la casse du lien. La moitié de mes liens étaient avec un "b" et l'autre avec un "B", ça fait toute la différence.

stnibedy · 23 Février 2011

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

kjin à dit:
Bonjour,
Pas regardé l'exemple en question

Code:

txt1 = "Ancien Texte" txt2 = "Nouveau Texte" For Each lnk In ActiveSheet.Hyperlinks If lnk.Address Like "*" & txt1 & "*" Then lnk.Address = Replace(lnk.Address, txt1, txt2) Next

A+
kjin

Que dois-je ajouter pour que ceci fonctionne pour toutes les feuilles d'un fichier.

Merci d'avance.

kjin · 23 Février 2011

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonsoir,

Code:

txt1 = "Ancien Texte"
txt2 = "Nouveau Texte"
For Each ws In Sheets
    For Each lnk In ws.Hyperlinks
        If lnk.Address Like "*" & txt1 & "*" Then lnk.Address = Replace(lnk.Address, txt1, txt2)
    Next
Next

A+
kjin

LAZ · 23 Mai 2011

Re : "chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hyper

Bonjour,
J'ai exactement le même problème sous Excel 2007. J'ai tenté votre solution mais cela ne fonctionne pas... Avez-vous une solution qui fonctionne avec 2007? Merci beaucoup aux experts pour votre temps.

"chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hypertexte

fox_mulder

XLDnaute Nouveau

kjin

XLDnaute Barbatruc

fox_mulder

XLDnaute Nouveau

kjin

XLDnaute Barbatruc

fox_mulder

XLDnaute Nouveau

kjin

XLDnaute Barbatruc

Pièces jointes

fox_mulder

XLDnaute Nouveau

Pièces jointes

kjin

XLDnaute Barbatruc

fox_mulder

XLDnaute Nouveau

fox_mulder

XLDnaute Nouveau

gb.bfp

XLDnaute Nouveau

Pièces jointes

le_nono31

XLDnaute Nouveau

stnibedy

XLDnaute Nouveau

kjin

XLDnaute Barbatruc

LAZ

XLDnaute Nouveau

Discussions similaires

"chercher-remplacer" 1 chaine de caractère pr modifier l'adresses de liens hypertexte

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency