[VBA-E] Macro VBA pour personaliser mon .doc depuis mon .xls

Version imprimable

Salut je suis débutant en VBA, je souhaite faire un prog vba qui me permete de générer automatiquement des lettres personalisées suivant un modèle word...

Pour cela j'ai un excel dans lequel j'ai mis un tableau avec en titre de colonnes les mots à rechercher et a remplacer comme &nom, &prénom, &adresse, puis dans chaque lignes les mots personalisé comme Durand, pierre, 47 rue de la paix

j'ai donc écrit cette macro mais elle plante sur
"ActiveWindow.View.ShowFieldCodes = True" et dit
"qualificateur incorrect" en surlignant view

Code:

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
 
Sub Bouton1_QuandClic()
'
' Bouton1_QuandClic Macro
' Macro enregistrée le 18/05/2006 par Jérôme JEAN-MARAULT
'
' Touche de raccourci du clavier: Ctrl+n
'
'
'Déclaration des vartiables
Dim col, lig As Integer
Dim Nomfichier As String
Dim Path As String
Dim texte1, texte2 As String
Dim MonDocument
Dim MonRepertoire
Dim NbDocuments As Integer
 
Path = ActiveWorkbook.Path + "\"
MonRepertoire = Path + "\Résultat\"
'Attention sous NT, il faut rajouter ces lignes qui comptent les fichiers sinon on ouvre et transforme en boucle :
MonDocument = Dir(MonRepertoire & "*.doc")
While MonDocument <> ""
  NbDocuments = NbDocuments + 1
  MonDocument = Dir
Wend
  'génération des fichiers copies de modèle
  For lig = 1 To ActiveSheet.Range("B5") Step 1    ' Boucle des lignes.
     FileCopy Path + "\Modele.doc", Path + "\Résultat\R_" + CStr(lig) + ".doc"
  Next lig
  'remplacement des mots
  For col = 1 To ActiveSheet.Range("B5") Step 1    ' Boucle des lignes.
     i = 1
     MonDocument = Dir(MonRepertoire & "*.doc")
     While MonDocument <> "" And i <= NbDocuments  'boucle des documents
       i = i + 1
       Documents.Open (MonRepertoire & "" & MonDocument)
       ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
       For lig = 1 To ActiveSheet.Range("A5") Step 1    ' Boucle des colonnes.
         texte1 = ActiveSheet.Cells(20, col)
         texte2 = ActiveSheet.Cells(lig + 20, col)
         Selection.Find.ClearFormatting
         Selection.Find.Replacement.ClearFormatting
         Set myRange = ActiveDocument.Content
         With myRange.Find
           .ClearFormatting
           .Replacement.ClearFormatting
           .Text = texte1
           .Replacement.Text = texte2
           .Execute Replace:=wdReplaceAll ' peut être la raison
         End With
         Selection.Fields.Update
       Next lig
       Documents(1).Close wdSaveChanges
       MonDocument = Dir
       MonDocument = Dir
     Wend
  Next col
End Sub

22/05/2006, 14h12
SfJ5Rpw8

si c'est une macro Excel qui gére un fichier Word.. tu dois utiliser la référence à Microsoft Word... de la même maniére que si tu piloter word depuis VB6 (ou autre) ... inspire toi de la FAQ VB :

8.3.1. Word(9)

Merci de ta réponse ça marche très bien voici la solution

Code:

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
 
Sub Bouton1_QuandClic()
'
' Bouton1_QuandClic Macro
' Macro enregistrée le 18/05/2006 par Jérôme JEAN-MARAULT
'
' Touche de raccourci du clavier: Ctrl+n
'
'
'Déclaration des vartiables
Dim col, lig As Integer
Dim Nomfichier As String
Dim Path As String
Dim texte1, texte2 As String
Dim MonDocument
Dim MonRepertoire
Dim NbDocuments As Integer
Dim DocWord As Word.Document
 
 
Path = ActiveWorkbook.Path + "\"
MonRepertoire = Path + "Résultat\"
'Attention sous NT, il faut rajouter ces lignes qui comptent les fichiers sinon on ouvre et transforme en boucle :
MonDocument = Dir(MonRepertoire & "*.doc")
While MonDocument <> ""
  NbDocuments = NbDocuments + 1
  MonDocument = Dir
Wend
  'génération des fichiers copies de modèle
  For lig = 1 To ActiveSheet.Range("B5") Step 1    ' Boucle des lignes.
     FileCopy Path + "\Modele.doc", Path + "\Résultat\R_" + CStr(lig) + ".doc"
  Next lig
  'remplacement des mots
  MonDocument = Dir(MonRepertoire & "*.doc")
  For lig = 1 To ActiveSheet.Range("B5") Step 1    ' Boucle des lignes.
    i = 1
    If i <= NbDocuments Then
       i = i + 1
        Set DocWord = GetObject(MonRepertoire + MonDocument)
        DocWord.Activate
 
       For col = 1 To ActiveSheet.Range("A5") Step 1    ' Boucle des colonnes.
         texte1 = ActiveSheet.Cells(20, col)
         texte2 = ActiveSheet.Cells(lig + 20, col)
         DocWord.ActiveWindow.View.ShowFieldCodes = True
         DocWord.ActiveWindow.Selection.Find.ClearFormatting
         DocWord.ActiveWindow.Selection.Find.Replacement.ClearFormatting
         Set myRange = DocWord.Content
         With myRange.Find
           .ClearFormatting
           .Replacement.ClearFormatting
           .Text = texte1
           .Replacement.Text = texte2
           .Execute Replace:=wdReplaceAll
         End With
         DocWord.ActiveWindow.Selection.Fields.Update
       Next col
 
       DocWord.Save
       DocWord.Close wdSaveChanges
       MonDocument = Dir
    End If
 
  Next lig
End Sub
 
:aie: