Mise en forme Excel 2016 vers Word 2016

Bonjour le forum

dans mon fichier quand j'exporte le contact il remplit un fichier dans word

le tableau est extrait mais je coince sur la mise en forme

NomDuFichier = ("D:\" & NomUtilisateur & "\Documents\Fichiers Clients\" & TextBox3.Value _
                    & " " & TextBox4.Value & " " & TextBox5.Value)
    On Error Resume Next
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Add
    WordApp.Selection.TypeText Text:="Détail du contact"    ' .....................................Insère du texte au point d'insertion
    WordApp.Selection.TypeParagraph    ' ..........................................................Sauter une ligne
    Wsz.Range("A1:B" & Wsz.Range("A" & Rows.Count).End(xlUp).Row).Select
    Selection.Font.Name = "Courier New"
    Selection.Font.Size = 10
    Selection.Copy
    WordDoc.Range.PasteSpecial    ' ...............................................................Colle les données dans Word
    ' -------------->> mettre la liste extraite dans un tableau sans texture
    ' -------------->>  Partie erronée
    'Selection.Shading.Texture = WordDoc.TextureNone
    'Selection.Shading.ForegroundPatternColor = WordDoc.ColorAutomatic
    'Selection.Shading.BackgroundPatternColor = WordDoc.ColorAutomatic
    'ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View.ShowAll
    'Selection.Tables(1).Style = "Grille du tableau"
    'ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View.ShowAl
    ' -------------->> fin de partie erronée
    Application.CutCopyMode = False
    WordDoc.SaveAs NomDuFichier    ' ..............................................................Enregistre les modifications
    WordApp.Quit    ' .............................................................................Quitte Word
    Set WordDoc = Nothing    ' ....................................................................Vide l'objet en mémoire
    Set WordApp = Nothing    ' ....................................................................Vide l'objet en mémoire
    MsgBox ("Document créé et rangé")

cordialement

Bonjour le forum

Voici le code en entier :

'**** Correspond au programme du CommandButton "Exporter"  ****
Private Sub CmdB_Exporter_Click()        ' ........................................................Bouton Exporter
    Set Wsz = Sheets("Feuille Temporaire")
    Application.ScreenUpdating = False
    For t = 1 To 68
        If Me.Controls("Checkbox" & t).Value = True Then
            GoTo LaSuite
        Else
            MsgBox "Vous n'avez rien coché !?", 48, "Attention"
            Exit Sub
        End If
    Next t
LaSuite:
    Wsz.Cells.ClearContents
    For M = 1 To 68
        If Me.Controls("CheckBox" & M).Value = True Then
            Wsz.Cells(1, M).Value = Me.Controls("CheckBox" & M).Caption
            Wsz.Cells(1, M).Interior.ColorIndex = 35        ' .....................................Vert
            Wsz.Cells(1, M).Font.ColorIndex = 41        ' .........................................Bleu
            Wsz.Cells(1, M).Font.Name = "Courrier New"""
            Wsz.Cells(1, M).Font.FontStyle = "Gras"
            Wsz.Cells(1, M).Font.Size = 12
            Wsz.Cells(2, M).Value = Me.Controls("TextBox" & M).Value
            Wsz.Cells(2, M).Font.Name = "Courrier New"
            Wsz.Cells(2, M).Font.Size = 12
        End If
    Next M
    Sheets("Feuille Temporaire").Select
    With Sheets("Feuille Temporaire")
        Range("A1:BP2").Select: Selection.Copy: Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Rows("1:2").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
        Columns("B:B").Select
        With Selection
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.ColumnWidth = 45
        .Range("A1").Select
        DétruireLigne
        .Range("B1").Interior.Color = xlNone
        .Range("B1").Interior.Pattern = xlNone
        .Range("B1").Font.ColorIndex = xlAutomatic
        .Range("B1").Font.Bold = False
    End With
    Application.DisplayAlerts = True
    ' ---------------------------------------------------------------------------------------------
    '                          Transferer les données exporter vers Word                          |
    ' ---------------------------------------------------------------------------------------------
    NomDuFichier = ("D:\" & NomUtilisateur & "\Documents\Fichiers Clients\" & TextBox3.Value _
                    & " " & TextBox4.Value & " " & TextBox5.Value)
    On Error Resume Next
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Add
    WordApp.Selection.TypeText Text:="Détail du contact"    ' .....................................Insère du texte au point d'insertion
    WordApp.Selection.TypeParagraph    ' ..........................................................Sauter une ligne
    Wsz.Range("A1:B" & Wsz.Range("A" & Rows.Count).End(xlUp).Row).Select
    Selection.Font.Name = "Courier New"
    Selection.Font.Size = 10
    Selection.Copy
    WordDoc.Range.PasteSpecial    ' ...............................................................Colle les données dans Word
    ' ---------------> Ma mise en forme dans Word
    'Selection.Shading.Texture = WordDoc.TextureNone
    'Selection.Shading.ForegroundPatternColor = WordDoc.ColorAutomatic
    'Selection.Shading.BackgroundPatternColor = WordDoc.ColorAutomatic
    'ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View.ShowAll
    'Selection.Tables(1).Style = "Grille du tableau"
    'ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View.ShowAl
    Application.CutCopyMode = False
    WordDoc.SaveAs NomDuFichier    ' ..............................................................Enregistre les modifications
    WordApp.Quit    ' .............................................................................Quitte Word
    Set WordDoc = Nothing    ' ....................................................................Vide l'objet en mémoire
    Set WordApp = Nothing    ' ....................................................................Vide l'objet en mémoire
    MsgBox ("Document créé et rangé")
    Unload Me
End Sub

Si besoin du fichier, je le fournirai à la prochaine réponse

Cordialement

bonsoir le forum

Je fais un UP car je ne comprends pas

Merci, cordialement

Rechercher des sujets similaires à "mise forme 2016 word"