Discussion :

[LeTrollDu27]

Bonjour le forum

Dans mon fichier contact quand je souhaite exporter le contact dans un fichier dans word
le tableau est extrait avec tous les renseignements souhaités mais je coince sur la mise en forme dans word par le controle d'Excel

Le code est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Option Explicit
 
Dim M As Integer
Dim F As Byte
Dim ChckB(68) As New ClasseChckB
Dim Wsl, Wsz As Worksheet 
Dim Ctrl As Control  
Dim t As Byte    
Dim NomDuFichier As String
Dim WordApp As Object
Dim WordDoc As Object  
 
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

En vous remerciant
Cordialement

[Menhir]

On ne peut pas utiliser les contrôle Excel pour mettre en forme du texte Word.
Même si la macro est placée dans Excel, les objets sont des objets Word et doivent donc être traités avec leurs propriétés et méthodes respectives.
C'est pour ça qu'il est nécessaire d'importer dans la macro la librairie Word (Outils > Références > Microsoft Word Object Library).

Il serait donc plus indiquer de poser cette question dans la rubrique VBA Word.