Macro automatique pour rechercher/remplacer

**Flaguette** · 07/05/2008, 20h55

Bonjour,

Notre compagnie a récemment changé de nom, ce qui nous impose des contraintes légales assez sévères.

J'aimerais ajouter dans le normal.dot (le mien et celui de mes collègues) une macro qui, à l'ouverture de n'importe quel document, rechercherait automatiquement l'ancien nom pour le remplacer par le nouveau.

Il se peut, naturellement, que l'ancien nom n'existe pas dans un document. Il ne faudrait pas que ça crée un message d'erreur : mes collègues hurleraient.

Je suis sous Office 2003.

J'ai des notions de VBA, mais créer une telle macro, ça dépasse un peu mes compétences et je manque un peu de temps pour approfondir.

Merci pour votre aide!

**Heureux-oli** · 07/05/2008, 21h24

Non, pas encore toi.

Salut !

C'est pas la solution!
Tu vas devoir laisser la macro en permanence.

Ce qui serait top, c'est un macro qui rechercherait les occurrences dans les modèles pour les changer.

Peut-être une macro au début, mais tu devrais t'en débarrasser au bout d'un moment.

Qu'en penses-tu ?

**Flaguette** · 07/05/2008, 21h42

Ben oui, encore moi! Mais là, tu devrais pourtant être content : j'ai un problème "normal"

Je ne saisis pas trop ce que tu veux dire.

Personnellement, j'utilise des modèles de lettre, différents pour chaque type de document envoyé, différents modèles de documents placés dans différents dossiers/sous-dossiers. Pour diverses raisons trop longues à énumérer, ces modèles ne sont pas tous dans les "dossiers modèles" (templates).

De plus, plusieurs de mes collègues travaillent souvent à partir de documents créés l'an dernier, ou même avant, plutôt que d'avoir à tout refaire à neuf.

Les documents créés alors que la compagnie s'appelait ABC doivent rester avec ce nom.

Mais s'ils sont ouverts pour en créer un nouveau pour cette année, le nom doit changer pour XYZ.

Naturellement, avant que le cycle complet ne soit effectué, on peut raisonnablement penser que ça peut prendre un peu plus d'un an.

C'est pourquoi j'avais pensé à une macro qui rechercherait et remplacerait automatiquement le nom.

À bien y penser, cette procédure devrait plutôt se faire sur "save" plutôt qu'à l'ouverture... juste pour s'assurer qu'un document qui n'a été que visionné reste tel qu'il était.

Ça ne me dérange pas que la macro reste en permanence... Ça va m'éviter de passer à chaque ordi à tout bout de champ (mes collègues immédiats seulement, c'est une dizaine de personnes)

Au pis aller, l'an prochain, ou dans deux ans, je désactive. Mais si aucun message d'erreur n'apparait si la macro ne trouve pas ABC, il n'y a aucun problème à le laisser, non?

**Heureux-oli** · 07/05/2008, 21h56

Voilà déjà un premier jet

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
Sub Document_Open()
Dim newName As String
Dim oldName As String
 
oldName = "olivier"
newName = "créez"
 
 
ActiveDocument.Range.Select
With Selection.Find
    .Text = oldName
    .Replacement.Text = newName
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindContinue
 
    .Execute Replace:=wdReplaceAll
End With
End Sub

Mais il est important de savoir si certains mots se trouvent dans l'en-tête ou le pied de page.
J'ai aussi des questions !!

**Heureux-oli** · 07/05/2008, 22h13

Si c'est avant la sauvegarde, regarde ici http://www.developpez.net/forums/sho...d.php?t=543732

**Flaguette** · 07/05/2008, 22h13

Merci!

J'essaie et je te reviens!

Et oui, dans certains documents il se peut que l'ancien nom soit dans l'en-tête ou dans le pied de page...

**Heureux-oli** · 07/05/2008, 22h27

Arrgh

La recherche et le remplacement ne fonctionnent dans l'entête et le pied de page que si on les active.

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
Sub Document_Open()
Dim newName As String
Dim oldName As String
 
oldName = "olivier"
newName = "créez"
 
 
ActiveDocument.Range.Select
With Selection.Find
    .Text = oldName
    .Replacement.Text = newName
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindContinue
 
    .Execute Replace:=wdReplaceAll
End With
 
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Select
With Selection.Find
    .Text = oldName
    .Replacement.Text = newName
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindContinue
 
    .Execute Replace:=wdReplaceAll
End With
 
Application.ActiveWindow.View.Type = wdPrintView
 
 
 
 
End Sub

Pour faire une recherche dans l'en-tête du document.

**Sepia** · 11/05/2008, 03h17

Salut Flaguette,

Juste une question, tu es sûr que légalement tu as le droit de changer le nom de la société (qui est responsable devant la Justice) pour des documents existants et déjà diffusés. Car en France, ce n'est pas légal, l'entité juridique responsable est celle qui a émis/diffusé le document en question et même en cas de reprise de la société (achat, fusion, changement de nom...), c'est l'ancienne entité qui est responsable (cela s'appelle le passif juridique) mais attention, cela ne veut pas dire que la nouvelle entité est exempte de toute poursuite.

La suite en MP

**Flaguette** · 16/05/2008, 05h37

Bon, j'ai fait quelques tests préliminaires mais ça ne donne pas tout à fait ce que je veux. Et je manque un peu de temps ces jours-ci... Je n'abandonne pas toutefois!

Merci Sepia pour la mise en garde... mais dans notre cas, la société s'appelait A.B. Machintruc et associés inc. mais, pour diverses raisons, s'appelle maintenant ABM Québec inc. (ABM représentant les mêmes lettres que dans A.B. Machintruc)

Il s'agit principalement d'une "signature", comme par exemple dans les lettres. Les documents ont été créés par A.B. Machintruc lorsque la compagnie s'appelait ainsi. Donc, dans ce cas, il n'y a aucun problème de copyright. Heureusement! Je n'ai pas envie d'être, encore une fois, "désignée volontaire" pour recréer tous nos modèles

, en sus de mon travail "régulier".

**Heureux-oli** · 16/05/2008, 09h00

Salut,

Dis nous ce qui ne focntionne pas correctement pour pouvoir y apporter des solutions ou corrections.

**306inside** · 07/07/2015, 22h20

Bonjour,

je relance le sujet car j'ai le meme soucis.

j'ai une vingtaine de balise dans le corps du document word que je remplace par la macro ci dessous.

Code :

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

1
2
3
4
Set myRange = Document_Rapport.Content 'Sélection de tout le document
 
myRange.Find.Execute FindText:=Balise, _
            ReplaceWith:=valeur_balise, Replace:=wdReplaceAll 'Remplacement"

Et, J'ai une balise dans l'entete du document "<NUM_CONVENTION>" utilisé par la valeur "Balise" et je n'arrive pas a remplacé la valeur "balise" par "valeur_balise".

le code ci dessous ne fonctionne pas, il ne modifie pas la valeur.

Code :

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

1
2
3
4
5
6
7
8
9
10
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Select
With Selection.Find
    .Text = Balise
    .Replacement.Text = valeur_balise 'valeur_balise
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindContinue
 
    .Execute Replace:=wdReplaceAll
End With

cela fait maintenant 3 jours que je suis deçu et je n'y arrive pas.

Est ce que quelqu'un pourrait m'aider

**Heureux-oli** · 08/07/2015, 11h47

Salut,

Comment affectes-tu le contenu de valeur_balise ?

**306inside** · 08/07/2015, 12h05

Envoyé par Heureux-oli

Salut,

Comment affectes-tu le contenu de valeur_balise ?

salut

j'affecte la valeur de valeur_balise comme cela

Code :

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

   valeur_balise = Tableau_bdd(Ligne, 2)

je te met le code entier de la macro de remplacement des balises.
avant ce code j'ai une macro qui récupère des valeurs dans un tableau excel.
Colonne 1 --> j'ai le nom de ma balise --> NUM_CONVENTION
Colonne 2 --> j'ai la valeur de la balise --> GDF2015006
Colonne 3 --> j'ai le type de la balise --> string

la macro boucle sur chaque ligne et remplace le nom de la balise par la valeur de la valise

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
129
130
131
132
133
134
135
136
137
138
139
Sub Ecriture_balise(Tableau_bdd() As String, Ligne As Integer, Application_word As Word.Application, Document_Rapport As Word.Document)
'Sélection et remplacement de toutes les balises du modèle word associées à la ligne par la chaîne de caractères associée
 
Dim Balise As String
Dim valeur_balise As String
'Pour convertir les heures en format HH:MM
Dim HH As Double
Dim MM As Double
Dim heure As Double
Dim longueur
Dim milliers
Dim k As Integer
Dim Nombre_separe As String
 
On Error Resume Next
'--------------------------------------------------------------------------
'Récupération des chaines de caractères "<Balise>" et "Valeur_balise"
'--------------------------------------------------------------------------
Balise = "<" & Tableau_bdd(Ligne, 1) & ">"
 
Select Case Tableau_bdd(Ligne, 3)
 
Case "nombre_0"
 
    valeur_balise = Round(CDbl(Tableau_bdd(Ligne, 2)), 0)
    valeur_balise = CStr(valeur_balise)
    Nombre_separe = ""
 
 
longueur = Len(valeur_balise)
milliers = (Len(valeur_balise)) / 3
 
If milliers > 1 Then
milliers = Int(milliers - 0.1)
    For k = 1 To milliers + 1
    Nombre_separe = Right(Left(valeur_balise, longueur - 3 * (k - 1)), 3) & Chr(160) & Nombre_separe
 
    Next k
    valeur_balise = Nombre_separe
Else
    valeur_balise = valeur_balise & Chr(160)
End If
 
Case "Nombre_1"
 
    valeur_balise = Round(CDbl(Tableau_bdd(Ligne, 2) * 10), 0)
    Decimale = Right(CStr(valeur_balise), 1)
    valeur_balise = Left(CStr(valeur_balise), Len(valeur_balise) - 1)
    Nombre_separe = ""
 
longueur = Len(valeur_balise)
milliers = Len(valeur_balise) / 3
 
If milliers > 1 Then
milliers = Int(milliers - 0.1)
    For k = 1 To milliers + 1
    Nombre_separe = Right(Left(valeur_balise, longueur - 3 * (k - 1)), 3) & Chr(160) & Nombre_separe
 
    Next k
    valeur_balise = Left(Nombre_separe, Len(Nombre_separe) - 1) & "," & Decimale & Chr(160)
Else
    valeur_balise = valeur_balise & "," & Decimale & Chr(160)
End If
 
 
Case "Nombre_2"
 
    valeur_balise = Round(CDbl(Tableau_bdd(Ligne, 2) * 100), 0)
    Decimale = Right(CStr(valeur_balise), 2)
    valeur_balise = Left(CStr(valeur_balise), Len(valeur_balise) - 2)
    Nombre_separe = ""
 
longueur = Len(valeur_balise)
milliers = Len(valeur_balise) / 3
 
If milliers > 1 Then
milliers = Int(milliers - 0.1)
    For k = 1 To milliers + 1
    Nombre_separe = Right(Left(valeur_balise, longueur - 3 * (k - 1)), 3) & Chr(160) & Nombre_separe
 
    Next k
    valeur_balise = Left(Nombre_separe, Len(Nombre_separe) - 1) & "," & Decimale & Chr(160)
Else
    valeur_balise = valeur_balise & "," & Decimale & Chr(160)
End If
 
 
Case "Heure"
    heure = CDbl(Tableau_bdd(Ligne, 2)) 'Sous format % de 24 h
    HH = Int(heure * 24)
    MM = Int((heure * 24 - HH) * 60)
    valeur_balise = HH & ":" & MM
 
Case Else
 
   valeur_balise = Tableau_bdd(Ligne, 2)
 
End Select
 
 
'--------------------------------------------------------------------------
'Remplacement de "<Balise>" par "Valeur_balise" dans tout le document
'--------------------------------------------------------------------------
 
Set myRange = Document_Rapport.Content 'Sélection de tout le document
 
myRange.Find.Execute FindText:=Balise, _
            ReplaceWith:=valeur_balise, Replace:=wdReplaceAll 'Remplacement"
Select Case Balise
    Case "<NOM_CLIENT>"
            For k = 2 To Document_Rapport.Sections.Count
                Document_Rapport.Sections(k).Footers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.Find.Execute FindText:=Balise, ReplaceWith:=valeur_balise, Replace:=wdReplaceAll 'Remplacement"
            Next k
    Case "<NOM_SITE>"
            For k = 2 To Document_Rapport.Sections.Count
                Document_Rapport.Sections(k).Footers(wdHeaderFooterPrimary).Range.Tables(1).Cell(2, 1).Range.Find.Execute FindText:=Balise, ReplaceWith:=valeur_balise, Replace:=wdReplaceAll 'Remplacement"
            Next k
End Select
 
 
'
If Balise = "<NUM_CONVENTION>" Then
 
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Select
With Selection.Find
    .Text = Balise
    .Replacement.Text = valeur_balise 'valeur_balise
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindContinue
 
    .Execute Replace:=wdReplaceAll
End With
 
'Application.ActiveWindow.View.Type = wdPrintView
 
End If
 
End Sub

merci pour ton aide

**Heureux-oli** · 08/07/2015, 13h18

Salut,

si le tableau est en Word, pour extraire la valeur, il faut enlever deux caractères.
Ligne 48 et 70 de ton code.

Si tu veux monitorer ton code tu peux toujours ajouter des debug.print pour voir ce que contiennent les différentes variables.

**306inside** · 08/07/2015, 21h49

salut,

les lignes 48 et 70 sont utilisé pour les balises de type nombre1 et nombre 2.

dans notre cas la valeur "NUM_CONVENTION" est de type String

Finalement je vient de trouvé la ligne. voir le code ci-dessous

Code :

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

Document_Rapport.Sections(1).Headers(wdHeaderFooterPrimary).Range.Find.Execute FindText:=Balise, ReplaceWith:=valeur_balise, Replace:=wdReplaceAll 'Remplacement"

Merci pour ton aide

**fbaux** · 25/04/2020, 10h27

bonjour à tous,
j'ai x tableaux dans y documents word
les tableaux sont de cette forme

x représente une case à cocher

peu importe le texte	OUI	NON
texte 1	X	X
texte 2	X	X

mon besoin faire des pdf formulaire le plus directement possible depuis ces fichiers word.

le caractère X actuellement utilisé dans le word est une case à cocher de la police Calibri peut être ChrW (61551) mais quand je transforme le word en pdf et ensuite je demande une transformation en formulaire pdf, cette case n'est pas reconnue :-(

pour que cela fonction dans mon formulaire pdf, actuellement en mode manuel , j'ulitise dans le word après modification manuelle
le caractère d'origine par une case à cocher (police wingdings2 caractère 163)
que je fais succéder par
1^ère colonne o en gris clair
2^nde colonne n en gris clair

==>

peu importe le texte	OUI	NON
texte 1	Wingdings 2 (caractère 163) O	Wingdings 2 (caractère 163) N
texte 2	Wingdings 2 (caractère 163) O	Wingdings 2 (caractère 163) N

vu que le O ou le N sont juste là pour repère pour acrobat repère que c'est une case à cocher

pouvez vous m'aider à automatiser svp?

==> remplacer

Code :

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

.Text = ChrW(61551)

par en alternance :Wingdings2 (caractère 163) O

Wingdings2 (caractère 163) n

j'ai bricolé ça :

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
Sub test()
'
' test Macro
'
'
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(61551)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.TypeBackspace
    Selection.InsertSymbol Font:="Wingdings 2", CharacterNumber:=-3933, _
        Unicode:=True
    Selection.TypeText Text:=" _"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Bold = wdToggle
 
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(61551)
        .Replacement.Text = ""
        .Font.Color = -570359809
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.TypeBackspace
    Selection.InsertSymbol Font:="Wingdings 2", CharacterNumber:=-3933, _
        Unicode:=True
    Selection.TypeText Text:=" _"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Bold = wdToggle
 
End Sub
Sub Macro1()
'
' Macro1 Macro
'
'
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Selection.Copy
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " _"
        .Replacement.Text = " _"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

mais quelqu'un peut-il m'aider svp?

**fbaux** · 13/05/2020, 13h32

bonjour quelqu'un pourrait-il m'aider stp ^

Macro automatique pour rechercher/remplacer

VBA Word

Discussions similaires

Partager

Partager