Mise en forme d’un tableau Word depuis Excel

apt

XLDnaute Impliqué
Bonjour à tous,

Dans un tableau Word issue d’une fusion de publipostage d’un champ DATABASE, j’aimerais mettre en forme mon tableau et cela depuis Excel.

La mise en forme comportera les bordures, la mise de la première ligne en gras, la définition de la largeur des colonnes.

J'ai fait un essai avec la première ligne du tableau en gras, mais ça n'a pas fonctionné :

Code:
        DocWord.MailMerge.Tables(1).Rows.First.Range.Font.Bold = True

Et voila le code de la macro Excel :

Code:
Sub Publipostage()
    Dim Chemin As String, FileMailing As String
    Dim NbreX As Long, i As Long
    Application.ScreenUpdating = False
    Chemin = ThisWorkbook.Path & "\"
    With Sheets("feuil1")
        .Activate
        NbreX = Application.CountIf(.Range(.[I2], .[I65536]), "x")
        If NbreX = 0 Then
            MsgBox "Il n'y a pas d'étiquette à extraire.", vbInformation + vbOKOnly
            .Range("A1").Select
            Exit Sub
        Else
            'FileMailing = Chemin & "Bon de commande.docx"
            '---
            Dim DerLg As Long
            DerLg = Range("A" & .Rows.Count).End(xlUp).Row

            With Range("A1:I" & DerLg)
                .Name = "Principale"
                .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
                                                                     "Q1:Q2"), CopyToRange:=.Range("L1:O1"), Unique:=True

            End With
            Range("L1").CurrentRegion.Name = "SDoublons"
        End If
    End With

    For i = 1 To NbreX
    Sheets("feuil1").Copy
    ActiveWorkbook.SaveAs Chemin & "Temp.xlsm", xlOpenXMLWorkbookMacroEnabled
    ActiveWorkbook.Close False

    ChDir ThisWorkbook.Path
    ' efface la croix de la colonne I
    With Sheets("Feuil1")
        .Range(.[I2], .[I65536]).ClearContents
    End With
    ' Ouverture de Word
    Dim AppWord As Word.Application
    Set AppWord = New Word.Application
    AppWord.Visible = True
    Set DocWord = AppWord.Documents.Open(FileMailing)
    nombase = Chemin & "Temp.xlsm"
    With DocWord.MailMerge
               .OpenDataSource Name:=nombase, _
                        Connection:="Driver={Microsoft Excel Driver (*.xls)};" & "DBQ=" & _
                                    nombase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [SDoublons]"
 
        'Spécifie la fusion vers un nouveau document (wdSendToPrinter= Vers l'imprimante)
        .Destination = wdSendToNewDocument
        '.SuppressBlankLines = True 'Il ne peut pas y voir de ligne blanche car on demande celle qui ont des croix
        '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
    ' Activation du document principal de Publipostage et fermeture
    DocWord.Activate
    DocWord.Close SaveChanges:=False
    ' Affichage l'application Word
    AppWord.Visible = True
    
    '--- ICI formatage du tableau résultant d'un champ de fusion DATABASE
    ' par exemple mettre la première ligne du premier tableau dans le document en gras
        DocWord.MailMerge.Tables(1).Rows.First.Range.Font.Bold = True
    ' Mais ce ne marche pas !!!?
    '---
    
    Set DocWord = Nothing
    Set AppWord = Nothing
    ' Activation de l'onglet
    ' Effacement du fichier temporaire créé spécialement pour la fusion
    Kill Chemin & "\temp.xlsm"
    Next i
    Application.ScreenUpdating = True
End Sub

Merci d’avance.
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 423
Membres
103 206
dernier inscrit
diambote