Bonjour,
je me permets de revenir sur un code que j'avais déjà posté il y a quelques jours. Mon problème était que la boucle for s'arrêtait après la 1ère itération.
Cela venait du fait que la propriété visible (voir code en gras) de l'application Word était sur false (je n'ai toujours pas compris ce problème...). Dans tous les cas ça marche maintenant, mais c'est très moche visuellement car à chaque itération Word se lance, le publipostage s'exécute, word sauvegarde et quitte, et tout ça de manière visuelle.
Pour le moment cela rend mon outil inutilisable au sens de l'utilisateur.

Merci de (re)soumettre vos idées.

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
Sub MakeMemos()
'crée des mémos dans word en utilisant l'automation
    Dim WordApp As Word.Application
   
    
    
'démarre word et crée un objet
    
    Set WordApp = New Word.Application
    WordApp.Visible = True 'si False la boucle ne boucle pas
    Application.ScreenUpdating = False
    
    
'information de la feuille de travail
    Set Data = Sheets("Feuil4").Range("A1")
    Message = Sheets("Feuil4").Range("E5")
    
'boucle sur les lignes de données
    Records = Application.CountA(Sheets("Feuil4").Range("A:A"))
    For i = 1 To Records
    
'mise à jour barre de progression
        Application.StatusBar = "Processing record" & i
        
'assigne la valeur courante aux variables
        Region = Data.Offset(i - 1, 0).Value
        SalesAmt = Format(Data.Offset(i - 1, 2).Value, "#,000")
        SalesNum = Data.Offset(i - 1, 1).Value
        
'détermine le nom du fichier
        SaveAsName = ThisWorkbook.Path & "\" & Region & ".doc"
        
'envoie des commandes à word
'On Error Resume Next
           

       With WordApp
       .Documents.Add
       
            With .Selection
                .Font.Size = 14
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
                .TypeText Text:="C O U C O U"
                .TypeParagraph
                .TypeParagraph
                .Font.Size = 12
                .ParagraphFormat.Alignment = 0
                .Font.Bold = False
                .TypeText Text:="Date:" & vbTab & _
                Format(Date, "mmmm d, yyyy")
                .TypeParagraph
                .TypeText Text:="To:" & vbTab & Region & _
                "Manager"
                .TypeParagraph
                .TypeText Text:="From:" & vbTab & _
                Application.UserName
                .TypeParagraph
                .TypeParagraph
                .TypeText Message
                .TypeParagraph
                .TypeParagraph
                .TypeText Text:="Units Sold:" & vbTab & _
                SalesNum
                .TypeParagraph
                .TypeText Text:="Amount:" & vbTab & _
                Format(SalesAmt, "$#,##0")
            End With
        .ActiveDocument.SaveAs Filename:=SaveAsName
            .ActiveWindow.Close
            End With
        
    Next i
    
    'tue l'objet
    WordApp.Quit
    Set WordApp = Nothing
    
    'reset
    Application.StatusBar = ""
    MsgBox Records & " memos ont été créés et sauvegardés dans " & _
    ThisWorkbook.Path
End Sub
Je rappelle que ce code est, à la base, tiré d'un livre Excel 2000