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

fox_mulder

XLDnaute Nouveau
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 ??:confused:

:rolleyes: 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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

Bonjour kjin

Merci beaucoup pour ton code, il fonctionne impec ...:D
:rolleyes: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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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 ...:rolleyes:

En te remerciant,

Fox
 

kjin

XLDnaute Barbatruc
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
 

Pièces jointes

  • foxmulder.xls
    29.5 KB · Affichages: 302
Dernière édition:

fox_mulder

XLDnaute Nouveau
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 ...:p) 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.
 

Pièces jointes

  • foxmulder_Bis.zip
    24.1 KB · Affichages: 139
  • foxmulder_Bis.zip
    24.1 KB · Affichages: 140
  • foxmulder_Bis.zip
    24.1 KB · Affichages: 156
Dernière édition:

kjin

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

Code:
Case 1 'pour que le message soit au singulier
Tu pousses un peu non ?! lien(s) aurait suffit je pense, mais bon...

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

Sinon, j'aurais d'autre question...ou plutôt ouvrir un nouveau sujet ?
Ouvre un nouveau fil, le forum est fait pour ça

...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

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

Rebonjour,
Ok pour tes remarques : je suis puriste lol
Tu pousses un peu non ?! lien(s) aurait suffit je pense, mais bon...
kjin

Sinon, ok je vais poster un nouveau sujet :
Ouvre un nouveau fil, le forum est fait pour ça
kjin

Ok, j'en prend note :p
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 :
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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
 

Pièces jointes

  • essai lien.xls
    48.5 KB · Affichages: 242
  • essai lien.xls
    48.5 KB · Affichages: 251
  • essai lien.xls
    48.5 KB · Affichages: 256
Dernière édition:

le_nono31

XLDnaute Nouveau
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

XLDnaute Nouveau
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

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

Merci d'avance.
 

kjin

XLDnaute Barbatruc
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

XLDnaute Nouveau
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.
 

Discussions similaires

Réponses
1
Affichages
1 K

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T