Discussion :

[Fanlou]

Bonjour,

Je dois faire des remplacements massifs de liens hypertextes dans Word 2003. J'ai trouvé ce code sur ce forum qui me permet de le faire dans le document sans difficulté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
For Each UnHyperlien In ActiveDocument.Hyperlinks
MaChaine = UnHyperlien.Address
If Left(MaChaine, 13) = "http://chemin" Then
UnHyperlien.Address = "http://voie" + Right(MaChaine, Len(MaChaine) - 13)
End If
Next UnHyperlien

Mon problème est que ce code ne fait pas les remplacements dans les zones de texte. Est-il possible de faire les 3 types de remplacement dans 1 seule macro soit les liens hypertextes :

• dans le document word;
• dans les zones de texte créées avec l'outil Dessin;
• dans les zones de texte créées avec le menu Insertion.

Si oui, quelqu'un peut me donner le code à utiliser ? Si non, je prendrais volontiers 2 ou 3 macros que je lancerai une après l'autre pour y arriver. Notez que je ne connais rien à VB mais que je suis assez débrouillarde pour copier les codes proposés en ajustant les texte à remplacer.

Merci infiniment à l'avance!

[Heureux-oli]

Salut,

essaies avec ce code pour voir ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub TestTextBox()
Dim intI As Integer
Dim myLn As Hyperlink
 
Debug.Print ActiveDocument.Shapes.Count
For intI = 1 To ActiveDocument.Shapes.Count
    ActiveDocument.Shapes(intI).Select
    For Each myLn In Selection.Hyperlinks
        Debug.Print myLn.Address
    Next myLn
Next intI
 
 
End Sub

[Fanlou]

D'accord mais où est-ce qu'on insère le texte de l'hyperlien recherché et celui par lequel il faut le remplacer dans le code que vous proposez ?

[Heureux-oli]

Salut,

Je pensais que c'était vrai

mais que je suis assez débrouillarde pour copier les codes proposés en ajustant les texte à remplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub TestTextBox()
Dim intI As Integer
Dim myLn As Hyperlink
Dim maChaine As String
 
Debug.Print ActiveDocument.Shapes.Count
For intI = 1 To ActiveDocument.Shapes.Count
    ActiveDocument.Shapes(intI).Select
    For Each myLn In Selection.Hyperlinks
        maChaine = myLn.Address
            If Left(MaChaine, 13) = "http://chemin" Then
              myLn.Address = "http://voie" + Right(MaChaine, Len(MaChaine) - 13)
            End If
    Next myLn
Next intI
 
 
End Sub

Mais on peut pour aller plus vite, utiliser une fonction Replace

http://heureuxoli.developpez.com/off...age13#L13-A-11

Replace(smyLn.Adress , "http://chemin", "http://voie")

[Fanlou]

Je suis assez débrouillarde en autant que le code à remplacer soit déjà positionné puisque je ne comprends rien à VB

En tout cas, j'ai testé et tout fonctionne parfaitement dans les 2 types de zone de texte.

Un grand merci!

[Fanlou]

Avec l'aide reçue grâce à ce forum, mon collègue Pierre a concocté ceci que nous partageons ici au cas où ça peut aider quelqu'un d'autre. Merci pour votre aide!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub Changement()
 
Dim intI As Integer
Dim myLn As Hyperlink
Dim Chaine As String
Dim Message, Title, Default, Texteremplace
Message = "Entrez le texte à remplacer"
Default = ""
Title = "TEXTE À REMPLACER"
Texteremplace = InputBox(Message, Title, Default)
 
Dim Message2, Title2, Default2, NewText
Message2 = "Entrez le texte de remplacement"
Default2 = ""
Title2 = "TEXTE DE REMPLACEMENT"
NewText = InputBox(Message2, Title2, Default2)
 
For Each UnHyperlien In ActiveDocument.Hyperlinks
 
Longueur = Len(Texteremplace)
maChaine = UnHyperlien.Address
If Left(maChaine, Longueur) = Texteremplace Then
UnHyperlien.Address = NewText + Right(maChaine, Len(maChaine) - Longueur)
End If
Next UnHyperlien
 
Debug.Print ActiveDocument.Shapes.Count
For intI = 1 To ActiveDocument.Shapes.Count
    ActiveDocument.Shapes(intI).Select
    For Each myLn In Selection.Hyperlinks
        Chaine = myLn.Address
            If Left(Chaine, Longueur) = Texteremplace Then
              myLn.Address = NewText + Right(Chaine, Len(Chaine) - Longueur)
            End If
    Next myLn
Next intI
 
End Sub