Définition automatique de tableau lors d'ouverture d'un publipostage
Bonjour,
Depuis un excel avec base de donnés j'ai un programme VBA qui me sort directement un fichier PDF d'étiquette prêt à imprimer. Cependant à l'ouverture du fichier Word de publipostage j'ai cette fenêtre qui apparaît :
Ici l'utilisateur doit donc cliquer sur OK.
J'aimerais savoir s'il est possible de valider cette étape automatiquement sans besoin d'input utilisateur, puisque mon programme a pour objectif d'être complètement automatique.
Merci d'avance,
James
Dim oDoc As Word.Document 'Ajout GVS
wChemin = ThisWorkbook.Path
wFicPublipostage = "etiquettes.docm"
Set wordApp = CreateObject("word.Application")
wordApp.Visible = False 'à changer dans programme final
Set oDoc = wordApp.Documents.Open(wChemin & "\" & wFicPublipostage) 'Ajout GVS
With oDoc.MailMerge
.OpenDataSource Name:=ThisWorkbook.Path & "\" & "Générer.xlsm", ReadOnly:=False, Connection:="bdd_etiquettes"
End With
S'il y a quelque chose à changer/rajouter, ce sera ici.
Je définis mon fichier word à ouvrir, puis j'utilise Mailmerge (=publipostage)
Re-bonjour,
Ca ne marche pas, la fenêtre apparaît toujours.
James
Re,
Voilà ce qui marche de mon côté
Sub Publipostage()
Dim wChemin As String, wFicPublipostage As String, sBdD As String
Dim WordApp As Object, oDoc As Object
wChemin = ThisWorkbook.Path & "\"
wFicPublipostage = "Etiquettes.docm"
sBdD = wChemin & "Générer.xlsm"
Set WordApp = CreateObject("word.Application")
WordApp.Visible = True
Set oDoc = WordApp.Documents.Open(wChemin & "\" & wFicPublipostage) 'Ajout GVS
With oDoc.MailMerge
.OpenDataSource Name:=sBdD, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & sBdD _
& ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OL", _
SQLStatement:="SELECT * FROM `bdd_etiquettes$`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
End With
End Sub
A voir aussi l'article Microsoft ICI
@+
Je vais essayer, merci pour votre aide :)
Rebonjour,
Votre solution ne marche pas chez moi
Je vous mets ici le code que j'ai pour l'instant. Il ne fonctionne pas, et me mets un erreur d'objet déjà défini à la ligne .OpenDataSource
Sub wordouvrir()
Dim oDoc As Word.Document 'Ajout GVS
wChemin = ThisWorkbook.Path
wFicPublipostage = "etiquettes.docm"
Set wordApp = CreateObject("word.Application")
wordApp.Visible = False 'à changer dans programme final
Set oDoc = wordApp.Documents.Open(wChemin & "\" & wFicPublipostage) 'Ajout GVS
With oDoc.MailMerge
.OpenDataSource Name:=ThisWorkbook.Path & "\" & "Générer.xlsm", ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & sBdD _
& ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OL", _
SQLStatement:="SELECT * FROM `bdd_etiquettes$`", SQLStatement:=" ", SubType:=wdMergeSubTypeAccess
'Connection:="bdd_etiquettes"
End With
With oDoc.MailMerge 'Export du ublipostage vers un nouveau doc
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
'export en pdf
wordApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"C:\Users\jcoulavin\Desktop\Générer des étiquettes\Etiquettes.pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
wordApp.ChangeFileOpenDirectory _
"C:\Users\jcoulavin\Desktop\Générer des étiquettes\"
'fermer word
Dim Appli As Word.Application
Dim WordDoc As Word.Document
Set Appli = GetObject(, "Word.Application")
Set WordDoc = Appli.Documents("C:\Users\jcoulavin\Desktop\Générer des étiquettes\etiquettes.docm")
WordDoc.Close SaveChanges:=wdDoNotSaveChanges
Appli.Quit SaveChanges:=wdDoNotSaveChanges
Set wordApp = Nothing
Set WordDoc = Nothing
Set Appli = Nothing
Set oDoc = Nothing
End Sub
Mais je ne comprends pas d'où vient cet erreur, puisque je en trouve pas d'objet spécifié 2 fois.