[VBA]Multi-Publipostage

Razor

XLDnaute Nouveau
Bonjour ou rebonjour pour certain.

Question un poil plus complexe : puis-je, grâce à une unique BBD sur Excel, publiposter sur plusieurs documents words différents, sur lesquels les champs de fusion sont déjà préparés.

Je pensais que grâce à une macro de ce genre on pourrait arriver à quelque chose mais je m'y connais encore pas assez.

Merci d'avance à ceux qui pourront y réfléchir.


Code:
Private Sub commandButton1_Click()
   [COLOR="Lime"] 'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"[/COLOR]
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String
    
    NomBase = "C:\dossier\labase.xls"
    
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
   [COLOR="Lime"] 'Ouverture du document principal Word[/COLOR]
    Set docWord = appWord.Documents.Open("C:\leDocument.doc")
    
    [COLOR="Lime"]'fonctionnalité de publipostage pour le document spécifié[/COLOR]
    With docWord.mailMerge
		[COLOR="Lime"]'Ouvre la base de données[/COLOR]
		.OpenDataSource Name:= NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
  [COLOR="Lime"]      'Spécifie la fusion vers l'imprimante[/COLOR]
        .Destination = wdSendToPrinter
        .suppressBlankLines = True
         [COLOR="Lime"]   'Prend en compte l'ensemble des enregistrements[/COLOR]
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
      [COLOR="Lime"]      End With
        'Exécute l'opération de publipostage[/COLOR]
        .Execute Pause:=False
    End With
    
    Application.ScreenUpdating = True
    
 [COLOR="Lime"]   'Fermeture du document Word[/COLOR]
    docWord.Close False
    appWord.Quit
End Sub
 

Caillou

XLDnaute Impliqué
Re : [VBA]Multi-Publipostage

Bonjour,

Je ne comprends pas bien ton problème !
Si ton code fonctionne pour c:\ledocument.doc
Code:
Set docWord = appWord.Documents.Open("C:\leDocument.doc")
Tu peux bien ré-exécuter le même code pour un deuxième document Word avec les champs préparés.

Caillou
 

Razor

XLDnaute Nouveau
Re : [VBA]Multi-Publipostage

Pour résumer (désolé je fait répéter c'est pour être sûr)

Mon code sera sous la forme :

Code:
Private Sub commandButton1_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
    
    NomBase = "C:\dossier\labase.xls"
    
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
   [I][COLOR="SeaGreen"] Set docWord = appWord.Documents.Open("C:\leDocument.doc")
    
    '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 [Feuil1$]"
        '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[/COLOR][/I]

 [I][COLOR="Orange"]Set docWord = appWord.Documents.Open("C:\deuxièmedoc.doc")
    
    '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 [Feuil1$]"
        '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[/COLOR][/I]
    appWord.Quit
End Sub
 
C

Compte Supprimé 979

Guest
Re : [VBA]Multi-Publipostage

Bonjour le fil, Razor,

Si j'ai bien compris et si une seule BdD est utilisée, ce code devrait faire l'affaire
Code:
[COLOR=blue]Private Sub[/COLOR] commandButton1_Click()
 [COLOR=green] ' Nécessite d'activer la référence "Microsoft Word xx.x Object Library"[/COLOR]
  [COLOR=blue]Dim[/COLOR] docWord [COLOR=blue]As[/COLOR] Word.document
  [COLOR=blue]Dim[/COLOR] appWord [COLOR=blue]As[/COLOR] Word.Application
  [COLOR=blue]Dim[/COLOR] NomBase [COLOR=blue]As String[/COLOR]
  [COLOR=blue]Dim[/COLOR] TabDoc() [COLOR=blue]As String[/COLOR], I [COLOR=blue]As Integer[/COLOR]
  NomBase = "C:\dossier\labase.xls"
  Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
  [COLOR=blue]Set[/COLOR] appWord = [COLOR=blue]New[/COLOR] Word.Application
  appWord.Visible = [COLOR=blue]True[/COLOR]
 [COLOR=green] ' Tableau des documents à ouvrir, séparateur choisi : #[/COLOR]
  TabDoc = Split("C:\leDocument.doc#C:\deuxièmedoc.doc", "#")
 [COLOR=green] ' Pour chaque document du tableau[/COLOR]
  [COLOR=blue]For[/COLOR] I = 0 [COLOR=blue]To UBound[/COLOR](TabDoc)
  [COLOR=green] 'Ouverture du/des document(s)[/COLOR]
    [COLOR=blue]Set[/COLOR] docWord = appWord.Documents.Open(TabDoc(I))
  [COLOR=green] 'fonctionnalité de publipostage pour le document spécifié[/COLOR]
    [COLOR=blue]With[/COLOR] docWord.mailMerge
    [COLOR=green] 'Ouvre la base de données[/COLOR]
      .OpenDataSource Name:=NomBase, _
                      Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
                                  "DBQ=" & NomBase & "; ReadOnly=True;", _
                      SQLStatement:="SELECT * FROM [Feuil1$]"
    [COLOR=green] 'Spécifie la fusion vers l'imprimante[/COLOR]
      .Destination = wdSendToPrinter
      .suppressBlankLines = [COLOR=blue]True[/COLOR]
    [COLOR=green] 'Prend en compte l'ensemble des enregistrements[/COLOR]
      [COLOR=blue]With[/COLOR] .DataSource
        .firstRecord = wdDefaultFirstRecord
        .lastRecord = wdDefaultLastRecord
      [COLOR=blue]End With[/COLOR]
    [COLOR=green] 'Exécute l'opération de publipostage[/COLOR]
      .Execute Pause:=False
    [COLOR=blue]End With[/COLOR]
  [COLOR=green] 'Fermeture du document Word[/COLOR]
    docWord.Close [COLOR=blue]False[/COLOR]
  [COLOR=blue]Next[/COLOR] I
  Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
  appWord.Quit
[COLOR=blue]End Sub[/COLOR]
[SIZE=-2][SIZE=+1][size=-1]Pour des codes plus lisible - Code créé par MRomain[/size][/SIZE][/SIZE]

A tester

A+
 
Dernière modification par un modérateur:

Razor

XLDnaute Nouveau
Re : [VBA]Multi-Publipostage

Hello ! Merci, donc j'ai testé, il bloque à ce niveau là avec un erreur type 5273 fichier non trouvé. Je dois aussi mettre un chemin ici ? Le nom de la base ?

.OpenDataSource Name:=NomBase, _
Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & NomBase & "; ReadOnly=True;", _
SQLStatement:="SELECT * FROM [Feuil1$]"

Edit : c'est bon le chemin est rectifié. Par contre nouveau message d'horreur :

Word n'a pas pu ouvrir le fichier de donnée.
 
Dernière édition:

Razor

XLDnaute Nouveau
Re : [VBA]Multi-Publipostage

Bonjour,

c'est vraiment bizarre ... il m'indique toujours que Word n'a pas pu ouvrir la source de données avec une erreur '5922'

Petite question le
Code:
SQLStatement:="SELECT * FROM [Feuil1$]"
c'est le nom de la feuille contenant les données ? Et le 'NomBase' , je ne dois pas le changer ? Parce que au moment où il bloque, il a réussi à afficher le premier doc word et le fichier excel ...

Et c'est quoi le _ à chaque fin de ligne dans la partie donnée au dessus ?

Merci d'avance

PS : je suis sous XL 2000
 
Dernière édition:

Razor

XLDnaute Nouveau
Re : [VBA]Multi-Publipostage

Re, j'ai trouvé un nouveau code j'essaie plusieurs alternative ...

Code:
# 'Creation de la fusion
# Dim mvarDocumentId As Variant
# Dim objWord As Word.Application
# Set objWord = CreateObject("Word.Application.8")
# Set mvarDocumentId = objWord.Documents.Add(CStr("chemin du fichier DOT") + CStr("Nom du fichier DOT"), False)
# objWord.ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
#
# objWord.ActiveDocument.MailMerge.OpenDataSource Name:= _
# App.Path & "Nom du fichier TXT", _
# ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
# AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
# WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
# Format:=wdOpenFormatAuto, Connection:= _
# "DSN=Text Files;DBQ=" & App.Path & ";DefaultDir=" & App.Path & ";DriverId=27;MaxBufferSize=2048;PageTimeout=5;" _
# , SQLStatement:="SELECT * FROM `Nom du fichier TXT`", SQLStatement1:=""
#
# With objWord.ActiveDocument.MailMerge
# .Destination = wdSendToNewDocument
# .MailAsAttachment = False
# .MailAddressFieldName = ""
# .MailSubject = ""
# .SuppressBlankLines = True
# With .DataSource
# .FirstRecord = wdDefaultFirstRecord
# .LastRecord = wdDefaultLastRecord
# End With
# .Execute Pause:=True
# End With
# objWord.ActivePrinter = "Xerox 4512 PCL5e"
# '"Xerox DocuPrint P8e PCL-5e"
#
# objWord.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
# wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
# Collate:=True, Background:=True, PrintToFile:=False
#
# objWord.ActivePrinter = "Xerox 4512 PCL5e"
#
# mvarDocumentId.Close False
# 'attente que l'impression des documents soit finis avant de quitter word
# While objWord.BackgroundPrintingStatus <> 0
# Wend
#
# objWord.Quit wdDoNotSaveChanges 'je ne sauvegarde pas les documents . la fin de l'impression
# Set objWord = Nothing

Quelqu'un peut me dire ce qu'il en pense ?
 

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 991
Membres
101 856
dernier inscrit
Marina40