Urgent - publipostage en VBA

Question

Bonjour!

 

J'aimerais pouvoir faire un publipostage (&#233;tiquettes) sous Word gr&#226;ce &#224; une macro qui va chercher des donn&#233;es dans Excel

 


J'ai naturellement enregistr&#233; une macro faisant ces op&#233;rations, mais quand je lance cette macro, il y a une erreur!!!!

 

 Voici le code pondu par Office, plus quelques ajouts:

 

 Sub CreeEtiquettes()

 '

 ' CreeEtiquettes Macro

 '

     Application.MailingLabel.DefaultLabelName =  "Zweckform 3479" ' ajout

 

     ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels 'format &#233;tiquettes



    'cherche la source de donn&#233;es

     ActiveDocument.MailMerge.OpenDataSource Name:= _ 

         "D:\xxxxxxxxxxxxxxxxxx.xls", ConfirmConversions:= _

         False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _

         PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _

         WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _

         Connection:= _


        "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User
ID=Admin;Data         Source=D:\xxxxxxxxxxxxxxxxxxxx.xls;Mode=Read;Extended
    Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDB:Database Password=""""" _

         , SQLStatement:="SELECT * FROM `Feuil1$`", SQLStatement1:="", SubType:= _

         wdMergeSubTypeAccess

 

 

     'champs de fusion

 

     ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _

         , Text:="""Anrede"""

     ' etc...............

         

     ' quelques lignes d'&#233;dition sans importance
     .
     .

     ' --------------------------------------
 
      WordBasic.MailMergePropagateLabel 
    'commande cr&#233;&#233; par Word et que Word n'arrive pas &#224; ex&#233;cuter!!!



    'J'ai mis ceci &#224; la place :    

 

     Set myMerge  = ActiveDocument.MailMerge

     myMerge.Execute

     

 End Sub

 


R&#233;sultat : la macro ouvre un nouveau document et &#233;crit les donn&#233;es
correctement, mais pas dans le format d'&#233;tiquettes que je veux :   elle fait une &#233;tiquette par page (au lieu de
27)............... :-(((   

 

 Ma question : connaissez-vous une commande qui peut ex&#233;cuter
correctement la propagation des &#233;tiquettes ou un autre moyen de faire
ce fichu publipostage?

 

Je suis au bord du suicide  et j'ai besoin de votre aide, merci d'avance!

jpleroisse · Answer

Bonsoir,
Modifie avec tes param&#232;ttres et essaie ceci.

Sub Fusionner()
    ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
    ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "C:\Mes documents\Ch&#234;ne &#224; clous.xls", ConfirmConversions:=False, ReadOnly _
        :=False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:= _
        "", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:="Feuille de calcul enti&#232;re", SQLStatement:="", SQLStatement1 _
        :=""
    Application.MailingLabel.DefaultPrintBarCode = False
    Application.MailingLabel.CreateNewDocument Name:="", Address:="", AutoText _
        :="OutilsCr&#233;erEtiquettes2"
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveWindow.ActivePane.SmallScroll Down:=296
    ActiveWindow.ActivePane.VerticalPercentScrolled = 49
    ActiveWindow.ActivePane.SmallScroll Down:=123
    ActiveWindow.ActivePane.VerticalPercentScrolled = 3
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeBackspace
    Selection.TypeBackspace
End Sub

jpleroisse

Mithrandiiir · Answer

Merci pour la r&#233;ponse!

En revanche, &#231;a ne marche pas encore... Un nouveau document est cr&#233;&#233; et son format est correct, mais les &#233;tiquettes sont d&#233;sesp&#233;r&#233;ment vides. Les donn&#233;es &#224; ins&#233;rer sont une simple feuille Excel avec sur la premi&#232;re ligne, les en-t&#234;tes (Titre, Nom, Pr&#233;nom, Adresse etc...) et sur les suivantes, les noms des destinataires. 2 questions :

1) A quoi correspond Autotext dans Application.MailingLabel.CreateNewDocument? Dois-je changer la cha&#238;ne que tu as mise?

2) Comment faire pour ins&#233;rer les donn&#233;es du tableur? Ca a quelque chose &#224; voir avec DataSource.FirstRecord et LastRecord? J'ai essay&#233; en rajoutant ceci avant le With ActiveDocument.MailMerge :

ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""Anrede"""
    Selection.TypeParagraph
        
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""Name"""
    Selection.TypeText Text:=" "
    
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""Vorname"""
    Selection.TypeParagraph
    
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""Strasse_Nr"""
    Selection.TypeParagraph
    
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""PLZ"""
    Selection.TypeText Text:=" "

De cette fa&#231;on, la 1&#232;re &#233;tiquette est correcte, mais toutes les autres sont vides...

Merci beaucoup, j'ai d&#233;j&#224; pu avancer, et j'esp&#232;re voir une r&#233;ponse &#224; mes questions!

Mithrandir

Urgent - publipostage en VBA

2 réponses

Discussions similaires