Macro find/replace qui a des loupés.

**_tuxy_** · 30/07/2018, 09h33

Bonjour,

Je cherche à créer une macro qui va remplacer des valeurs par une autre (mettre en majuscule avec des crochets).

Pour le moment j'ai pondu cela qui fonctionne à peu prés.

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Sub MAMACRO()
'
' MAMACRO Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Am"
        .Replacement.Text = "[Am]"
        .Forward = False
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With Selection
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
 
 
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "C"
        .Replacement.Text = "[C]"
        .Forward = False
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With Selection
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
 
 
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "B"
        .Replacement.Text = "[B]"
        .Forward = False
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With Selection
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
 
 
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "D"
        .Replacement.Text = "[D]"
        .Forward = False
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With Selection
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = False Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    End Sub

Je n'ai pas mis tout le code mais grosso-modo cela fait le job pour X lettres de l'alphabet.
Je pense que d'une part il sera plus propre de stocker les valeurs avant/après dans un tableau.
Mais là n'est pas le plus gros du problème. Les problèmes sont :
- la macro me loupe certaines occurences
- la macro agit dans tout le document, au lieu d'agir uniquement sur ma sélection de texte (malgré le test d'un wdReplaceOne)

Je ne suis pas spécialiste, mais je pense qu'un spécialiste aura plus de chance que moi de voir le problème.
En vous remerciant d'avance.

Invité · 17/08/2018, 07h28

Envoyé par _tuxy_

Bonjour,

A tester :

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Option Explicit
 
Sub RemplacerLesChaines()
 
Dim DocEnCours As Document
Dim I As Long, J As Long
Dim MatriceValeurs() As Variant
Dim MesValeurs As Variant
Dim MaSelection As Selection
Dim MaChaine As String
Dim Continuer As Boolean
 
    MesValeurs = Array("Am", "B", "C", "D")
    ReDim MatriceValeurs(UBound(MesValeurs), 1)
    For I = LBound(MatriceValeurs, 1) To UBound(MatriceValeurs, 1)
        MatriceValeurs(I, 0) = MesValeurs(I)
        MatriceValeurs(I, 1) = "[" & MesValeurs(I) & "]"
    Next I
 
 
    Set DocEnCours = ActiveDocument
    With DocEnCours
         Set MaSelection = Selection
         MaChaine = ""
         For I = 1 To Len(MaSelection.Range.Text)
             Continuer = True
 
             For J = LBound(MatriceValeurs, 1) To UBound(MatriceValeurs, 1)
 
                 If Mid(MaSelection.Range.Text, I, Len(MatriceValeurs(J, 1))) = MatriceValeurs(J, 1) Then
                    MaChaine = MaChaine & MatriceValeurs(J, 1)
                    I = I + Len(MatriceValeurs(J, 1)) - 1
                    Continuer = False
                 End If
 
                 If Mid(MaSelection.Range.Text, I, Len(MatriceValeurs(J, 0))) = MatriceValeurs(J, 0) And Continuer = True Then
                    MaChaine = MaChaine & MatriceValeurs(J, 1)
                    I = I + Len(MatriceValeurs(J, 0)) - 1
                    Continuer = False
                 End If
 
             Next J
 
             If Continuer = True Then
                MaChaine = MaChaine & Mid(MaSelection.Range.Text, I, 1)
             End If
 
             'Debug.Print MaChaine
 
         Next I
 
         MaSelection.Range.Text = MaChaine
         Set MaSelection = Nothing
 
    End With
 
    Set DocEnCours = Nothing
 
End Sub

**_tuxy_** · 18/08/2018, 13h38

je vais voir à l'utilisation, mais quelques tests me montrent déjà que c'est parfait !!
mille mercis.

Invité · 18/08/2018, 13h42

Envoyé par _tuxy_

Bonjour,

Simple curiosité, quelle est la finalité de ce code ?

**_tuxy_** · 16/10/2018, 20h50

Désolé je n'avais pas vu la dernière réponse, j'ai dû passer pour quelqu'un de malpoli qui a eu ce qu'il voulait.
Il n'en est rien, vaut mieux tard que jamais. Donc en fait cette macro sert dans le cadre de tablatures de guitare, que je rédige moi même ou récupère parfois sur internet. Il y a des accords que j'aime mettre en forme pour qu'ils ressortent davantage par rapport au texte (de la chanson). C'est bête

c'est mon côté maniaque certainement.

Invité · 17/10/2018, 01h13

Envoyé par _tuxy_

Bonjour,

OK, merci pour ces explications.

Macro find/replace qui a des loupés.

VBA Word

Discussions similaires

Partager

Partager