Mise en forme Excel 2016 vers Word 2016 Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Le_Troll_Du_27
Membre fidèle
Membre fidèle
Messages : 164
Inscrit le : 14 juillet 2015
Version d'Excel : 2019 FR 64 Bits
Contact :

Message par Le_Troll_Du_27 » 17 novembre 2016, 03:59

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
Modifié en dernier par Le_Troll_Du_27 le 17 novembre 2016, 09:53, modifié 1 fois.
Qui donne ne doit jamais s'en souvenir, qui reçoit ne doit jamais l'oublier


Date and Time Picker and MonthView - Windows 64/32:
http://forum.excel-pratique.com/excel/date-and-time-picker-windows-64-32-t79032-20.html
Avatar du membre
Le_Troll_Du_27
Membre fidèle
Membre fidèle
Messages : 164
Inscrit le : 14 juillet 2015
Version d'Excel : 2019 FR 64 Bits
Contact :

Message par Le_Troll_Du_27 » 17 novembre 2016, 09:52

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
Qui donne ne doit jamais s'en souvenir, qui reçoit ne doit jamais l'oublier


Date and Time Picker and MonthView - Windows 64/32:
http://forum.excel-pratique.com/excel/date-and-time-picker-windows-64-32-t79032-20.html
Avatar du membre
Le_Troll_Du_27
Membre fidèle
Membre fidèle
Messages : 164
Inscrit le : 14 juillet 2015
Version d'Excel : 2019 FR 64 Bits
Contact :

Message par Le_Troll_Du_27 » 17 novembre 2016, 18:47

bonsoir le forum

Je fais un UP car je ne comprends pas

:help:

Merci, cordialement
Qui donne ne doit jamais s'en souvenir, qui reçoit ne doit jamais l'oublier


Date and Time Picker and MonthView - Windows 64/32:
http://forum.excel-pratique.com/excel/date-and-time-picker-windows-64-32-t79032-20.html
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message