Discussion :

[Chtik]

Bonjour,

Je souhaiterais automatiser un publipostage à partir d'un fichier excel.
Pour cela j'ai récupérer et adapter le code de SilkyRoad, publier ici :

Mon problème est le suivant :
Au lieu de générer l'impression de 7 pages (phase de test), j'obtiens l'impression des 7 pages remplies, comme prévu, et un nombre illimité de pages vierges à la suite si je n'arrête pas la macro.
Exemple : Bloc adresse sur 7 pages + 2 000 pages vierges

Auriez vous une solution à ce problème ?

Je précise que le publipostage "manuel" fonctionne parfaitement.

Voici le code :

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
Sub PublipostageEtiquettes()
    'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String
    Dim NomFicherWord As String
 
    NomBase = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    NomFicherWord = ThisWorkbook.Path & "\Etiquettes.docx"
 
    Select Case MsgBox("S'assurer que l'imprimante est allumée et que le papier a étiquettes est chargé dedans." & Chr(10) & Chr(10) & _
    "Cliquer sur Annuler pour stopper le processus d'impression des étiquettes", vbOKCancel, "Impression des étiquettes : 1ère étape")
    Case vbCancel
    MsgBox "L'impression a été interrompue.", vbOKOnly, "Arrêt de l'impression"
    Exit Sub
    Case vbOK
 
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomFicherWord)
 
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.MailMerge
        'Ouvre la base de données
        .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Tableau adhérents$]"
        'Spécifie la fusion vers l'imprimante
       ' .Destination = wdSendToPrinter
        .SuppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
 
    Application.ScreenUpdating = True
 
    'Fermeture du document Word
    docWord.Close False
    appWord.Quit
 
    MsgBox "Impression des étiquettes en cours..." & Chr(10) & Chr(10) & "Cliquer sur Ok pour revenir au fichier", vbOKOnly, "Impression en cours"
    End Select
 
End Sub

Merci d'avance,

[Chtik]

Bonjour,

J'ai trouvé la solution à mon problème en ajoutant la ligne suivante :

Code :

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

.MainDocumentType = wdFormLetters

Voici donc ma macro corrigée :

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
Private Sub CommandButton2_Click()
    'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String
    Dim NomFicherWord As String
 
    NomBase = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    NomFicherWord = ThisWorkbook.Path & "\Etiquettes.docx"
 
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomFicherWord)
 
 
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.MailMerge
        .MainDocumentType = wdFormLetters
        'Ouvre la base de données
        .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Tableau adhérents$]", _
        SQLStatement1:="", SubType:=wdMergeSubTypeAccess
        'Spécifie la fusion vers l'imprimante
       ' .Destination = wdSendToNewDocument
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
 
    Application.ScreenUpdating = True
 
    'Fermeture du document Word
    docWord.Close False
    appWord.Quit  
 
End Sub

Merci