Publipostage multiple Excel - Word

cs_apz Messages postés 281 Date d'inscription dimanche 7 avril 2002 Statut Membre Dernière intervention 11 avril 2013 - 8 avril 2013 à 17:37
cs_apz Messages postés 281 Date d'inscription dimanche 7 avril 2002 Statut Membre Dernière intervention 11 avril 2013 - 11 avril 2013 à 20:40
Bonjour à tous,

Voila un exemple, de publipostage multiple, avec du code VBA Excel et Word, que j'aimerais corriger.

Solution à trouver aux problèmes suivants :

- Problème pour publier tous les enregistrements marqués par une croix dans la feuille Excel.

- Formatage du tableau :

Le code se trouve bien mais rien ne se passe :

    Private Sub Document_Open()
        TableOptimize
    End Sub


    Sub TableOptimize()
        Dim myTable As Table
        'If Selection.Information(wdWithInTable) = False Then Exit Sub
       'Set myTable = Selection.Tables(1)
        Set myTable = Application.ActiveDocument.Tables(1)
        With myTable
            '.Range.Style = "ANewStyle"
           .AutoFitBehavior (wdAutoFitContent)
            '.AutoFormat Format:=wdTableFormatContemporary    '35
           'Ajustement des colonnes
           .AutoFitBehavior (wdAutoFitWindow)
            .AutoFitBehavior (wdAutoFitFixed)
            .AutoFitBehavior wdAutoFitContent
            'Bordures
           .Columns.Borders.Enable = True
            .Rows.Borders.Enable = True
            'Mettre les titres de la première ligne en gras
           .Rows.First.Range.Font.Bold = True
            'Centrer les titres
           .Rows(1).Alignment = wdAlignRowCenter
            'Centrer le contenu de la 1ère colonne
           .Columns(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
            'Réduire la largeur de la première colonne
           .Columns(1).Width = 15
            'Centrer le contenu de la 4ème colonne
           .Columns(4).Cells.VerticalAlignment = wdCellAlignVerticalCenter
         
        End With
    End Sub


http://cjoint.com/?CDirJaAmZfa

Merci d'avance.

7 réponses

Utilisateur anonyme
8 avril 2013 à 19:45
Bonjour,

Voila un exemple, de publipostage multiple, avec du code VBA Excel et Word, que j'aimerais corriger.



Mon œil ! Il n'y a aucun code pour Excel là-dedans. Et puis, tout ce que tu as à faire c'est de piloter l'assistant publipostage de Word par automation.
0
cs_apz Messages postés 281 Date d'inscription dimanche 7 avril 2002 Statut Membre Dernière intervention 11 avril 2013
8 avril 2013 à 19:55
Bonjour cmarcotte,

Regarde ce lien en bas du post :

http://cjoint.com/?CDirJaAmZfa
0
Utilisateur anonyme
8 avril 2013 à 20:28
Bonjour,

Si tu penses que je vais ouvrir un fichier inconnu, juste pour voir, tu rêves en couleurs et en noir et blanc en même temps.
0
cs_apz Messages postés 281 Date d'inscription dimanche 7 avril 2002 Statut Membre Dernière intervention 11 avril 2013
8 avril 2013 à 23:27
Bonsoir,

Un exemple avec des données peut mieux servir pour comprendre le problème et sert vite à trouver une solution.

Mais je crois que je n'ai pas le choix

Voila le code VBA/Excel :

Option Explicit

'---------------------------------
Sub test()
    Dim R As Range
    Set R = ThisDocument.Tables(1).Range
    R.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    R.Paragraphs.Alignment = wdAlignParagraphCenter
End Sub
'---------------------------------
Option Explicit
Sub Impression()
    PreparerPlages
    Publipostage
End Sub
Sub PreparerPlages()
'
' PublipostageTest Macro
' Code pour un publipostage multiple
'
    Dim DerLg As Long

    With Feuil1
        DerLg = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:P" & DerLg).Name = "Base"
        [Base].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
                                                                   "AA1:AA2"), CopyToRange:=Range("R1:X1"), Unique:=True

        .Range("R1:Y" & .UsedRange.Rows.Count).RemoveDuplicates Columns:=1, Header:=xlYes
        '.Range(.[R1], .Cells(.Rows.Count, 25).End(xlUp).Row).Name = "Extraction"
        .Range("R1:Y" & .UsedRange.Rows.Count).Name = "Extraction"
        MsgBox "Extraction : " & Range("extraction").Address

    End With
End Sub
Sub Publipostage()
'Ajouter la référence suivante à partir du menu
'de la fenêtre de l'éditeur de code
'barre des menus / outils / références
'référence à cocher : "Microsoft Word xx Object Library"

    Dim Wd As Word.Application, WdDoc As Word.Document
    Dim Chemin As String, Fichier As String, Source As String

    'En supposant que le document Word est dans le
    'même répertoire que le fichier Excel ouvert
    Chemin = ThisWorkbook.Path & ""
    'Fichier = "Décharge.doc"
    Fichier = "PublipostageMultiple (v002).docm"
    'Chemin & Nom du fichier Excel où est le tableau des données
    'Ce fichier est présumé ouvert
    Source = ThisWorkbook.FullName

    'Création d'une instance de Word
    Set Wd = CreateObject("Word.Application")
    'Rendre visible ou nom l'application Word
    Wd.Visible = True    ' or False

    'Ouverture du document pour la publication
    '            Set WdDoc = Wd.Documents.Open(Chemin & Fichier)
    '-----------
    Dim Ref As Range
    For Each Ref In Range("extraction").Columns(1).Cells
        If Ref <> "" Then
            MsgBox "Reference = " & Ref
            '---------
            'Ouverture du document pour la publication
            Set WdDoc = Wd.Documents.Open(Chemin & Fichier)

            With WdDoc
                ' Source contient le chemin d'accés au fichier
                .MailMerge.OpenDataSource _
                        Name:=Source, _
                        LinkToSource:=True, _
                        Format:=wdOpenFormatAuto, _
                        Connection:="Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                    "Data Source=" & ThisWorkbook.FullName & ";" & _
                                    "Extended Properties=""Excel 8.0;HDR=Yes;""", _
                                    SQLStatement:="SELECT * FROM `Données` Where Données.Impression='X'"

                'déterminer au besoin l'imprimante pour ce document
                '.ActivePrinter = "Xerox 4512 PCL5e"

                ' Lancer l'impression du publipostage
                With .MailMerge
                    .Destination = wdSendToNewDocument    'OU wdSendToPrinter après test
                    With .DataSource
                        .FirstRecord = wdDefaultFirstRecord
                        .LastRecord = wdDefaultLastRecord
                    End With
                    .Execute Pause:=False
                End With

                'Attente que l'impression soit terminée avant de fermé
                'le document et Word
                While Wd.BackgroundPrintingStatus <> 0
                    DoEvents
                Wend
                'Execution de la macro formatage et centrage du tableau
                'dans le document résultant
                'WdDoc.RunAutoMacro (wdAutoExec)

                '.Close SaveChanges:=wdDoNotSaveChanges  'Ferme le document
                'Ferme Word
                'Wd.Quit wdDoNotSaveChanges

            End With
            '---------

        End If
    Next Ref
    '-----------
    'Libère la mémoire occupée par les objects
    Set WdDoc = Nothing
    Set Wd = Nothing

End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Utilisateur anonyme
9 avril 2013 à 01:42
Bonjour,

Et si tu le passes au pas à pas en vérifiant la valeur des variables, cela donne quoi ?

Quelle version d'Excel ? À partir d'Excel 2007 on ne peut plus utiliser le moteur JET et il faut utiliser le moteur ACE
0
cs_apz Messages postés 281 Date d'inscription dimanche 7 avril 2002 Statut Membre Dernière intervention 11 avril 2013
9 avril 2013 à 11:02
Bonjour cmarcotte,

J'ai changé le moteur, et j'ai suivi l'exécution pas à pas, pour obtenir la publication de trois enregistrements

En résultat, j'obtiens 3 documents de fusion avec les mêmes données, au lieu de deux documents (Comme il y a deux lignes qui ont la même référence dans la feuille Excel, un seul document devra regrouper les deux lignes)
0
cs_apz Messages postés 281 Date d'inscription dimanche 7 avril 2002 Statut Membre Dernière intervention 11 avril 2013
11 avril 2013 à 20:40
Bonsoir,

J'ai la plage nommée de "Données" vers "Base" qui est définie en haut dans la ligne suivante :

SQLStatement:="SELECT * FROM `Base` Where Base.Impression='x"



Mais toujours le même résultat
0