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 :

image

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

Bonjour JamesC

Quel est le code VBA utilisé ?

@+

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)

Bonjour JamesC

Essayez avec

Connection:="bdd_etiquettes$"

@+

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.

Rechercher des sujets similaires à "definition automatique tableau lors ouverture publipostage"