Discussion :

[Bearn 64]

Bonjour Le Forum

Je souhaite faire un publipostage depuis Excel a l'aide de Word "feuille CC.docm publipostage prépare", avec impression d'une seule ligne la deuxième de la Base, la première étant les titres.
Et enregistrer La Lettre Type1 dans un dossier avec comme nom le champ 1 et 2 et date enregistrée dans une feuille Parametres.
Voila la macro mais helas je n'arrive pas a enregistrer en fichier.

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
Sub Imprime()
'--------------------------- Sauve 
ThisWorkbook.Save
 
    '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
 
    NomBase = "F:\Base.xlsm"
 
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open("F:\CC.docm")
 
    '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 [Commandes$]"
        '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
 
'--------------------------------------------------------------------------------
With docWord.MailMerge
appWord.DisplayAlerts = False
          NomSource = "F:\"
          Nom = .DataSource.DataFields(1).Value
          Prenom = .DataSource.DataFields(2).Value
          Datej = Format([Parametres!B5], "dd-mm-yyyy hh-mm")
          DocName = NomSource & Nom & "-" & Prenom & " " & Datej
'
With Dialogs(wdDialogFileSaveAs)
.Name = DocName
.Execute
ActiveDocument.SaveAs Filename:=DocName
 
End With
appWord.Quit SaveChanges:=wdDoNotSaveChanges
 
End With
'----------------------------------------------------------------------------------------
    Application.ScreenUpdating = True
 
    'Fermeture du document Word
    docWord.Close False
    appWord.Quit
End Sub

Merci de votre expertise.

[Bearn 64]

Bonsoir le Forum

Un embryon de réponse

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
Sub Publipostage()
'--------------------------- Sauve
ThisWorkbook.Save
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
Dim wdApp As Word.Application
Dim strCheminDoc As String, strCheminFusion As String
Dim strSQL As String
 
NomBase = "F:\Base.xlsm"
 
' Chemin du document Word à ouvrir
strCheminDoc = "F:\CC.docm"
 
' Démarrer Word
Set wdApp = New Word.Application
With wdApp
' Rendre Word visible pour faciliter la mise au point
.Visible = True
 
' Ouvrir le document de publipostage
.Documents.Open strCheminDoc
 
' Paramétrer le publipostage
With .ActiveDocument.MailMerge
.OpenDataSource Name:=NomBase, _
          Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
          "DBQ=" & NomBase & "; ReadOnly=True;", _
          SQLStatement:="SELECT * FROM [Commandes$]"
 
' Chemin du document Word à créer (résultat de la fusion)
wdApp.DisplayAlerts = False
          NomSource = "F:\"
          Nom = .DataSource.DataFields(1).Value
          Prenom = .DataSource.DataFields(2).Value
          Datej = Format([Parametres!B5], "dd-mm-yyyy hh-mm")
          DocName = NomSource & Nom & "-" & Prenom & " " & Datej
 
strCheminFusion = DocName & ".doc"
 
' Diriger le publipostage vers un nouveau document plutôt que vers l'imprimante
.Destination = wdSendToNewDocument
' Lancer la fusion
.Execute
 
' Diriger le publipostage vers l'imprimante
.Destination = wdSendToPrinter
 
' Lancer la fusion
.Execute
End With
 
' Sauvegarder le document fusionné
.ActiveDocument.SaveAs Filename:=strCheminFusion
 
' Quitter Word
.Quit SaveChanges:=wdDoNotSaveChanges
End With
 
' Fermer et libérer les objets
Set wdApp = Nothing
End Sub

Qui imprime publipostage et sauvegarde sous fichier nom client prénom et date