[Résolu] Éviter les boucles pour créer le tableau

[Lone-wolf]

Bonjour à tous


Voici la macro pour copier et mettre en forme un tableau dans Word

Sub CopierTableau()
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim fichier As String
Dim B, C, P


'Chemin du doc dans le même dossier qu'Excel
fichier = ThisWorkbook.Path & "\Modele.doc"


Set AppWord = New Word.Application
AppWord.Visible = True

Application.DisplayAlerts = False
Application.WindowState = xlMinimized

'Copie les données Excel
ThisWorkbook.Worksheets("Feuil1").Range("A1").CurrentRegion.Copy

'Ouvre le document Word
Set DocWord = AppWord.Documents.Open(fichier, ReadOnly:=False)

'Colle les données dans Word
DocWord.Range.Paste

'Appliquer les bordures + formatage
With DocWord
'Ajustement automatique des lignes et des colonnes
.Tables(1).AutoFitBehavior wdAutoFitWindow
.Tables(1).AllowAutoFit = True

  Application.ScreenUpdating = False
 'Traitement des lignes contour du tableau
    For B = -4 To -1
        With .Range.Borders(B)
            .Visible = True
            .Color = wdColorDarkRed
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth025pt
        End With
    Next
      
     'Traitement des colonnes
    For Each C In .Tables(1).Range.Columns
        With C.Borders(wdBorderHorizontal)
            .Visible = True
            .Color = wdColorGray125
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
     Next

     'Traitement des lignes
     For Each L In .Tables(1).Range.Rows
            With L.Borders(wdBorderVertical)
                .Visible = True
                .Color = wdColorGray125
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth050pt
            End With
    Next
 End With
    
'Supprime la sélection dans Excel
Application.CutCopyMode = False
'Enregistre les modifications
DocWord.Save
Application.WindowState = xlNormal

  'Ferme le document
'AppWord.Application.Quit
End Sub

Ma question est: est-ce qu'il y a un moyen d'éviter les boucles pour la mise en forme du tableau?

 

[Lone-wolf]

Re : Éviter les boucles pour créer le tableau

Re,

bon, au final c'était très simple. Désolé pour le post.

Voici la macro corrigée.

Sub CopierTableau()
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim fichier As String
Dim B, C, P


'Chemin du doc dans le même dossier excel
fichier = ThisWorkbook.Path & "\Modele.doc"

'Appel de l'application Word
Set AppWord = New Word.Application
AppWord.Visible = True

Application.DisplayAlerts = False
Application.WindowState = xlMinimized

'Copie les données Excel
ThisWorkbook.Worksheets("Feuil1").Range("A1").CurrentRegion.Copy

'Ouvre le document Word
Set DocWord = AppWord.Documents.Open(fichier, ReadOnly:=False)

'Colle les données dans Word
DocWord.Range.Paste

'Applique les bordures + formatage
With DocWord
'Ajustement automatique des colonnes
.Tables(1).AutoFitBehavior wdAutoFitWindow
.Tables(1).AllowAutoFit = True

  Application.ScreenUpdating = False
 'Traitement des lignes contour du tableau
    For B = -4 To -1
        With .Range.Borders(B)
            .Visible = True
            .Color = wdColorDarkRed
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth025pt
        End With
    Next
      
        'Traitement des colonnes
        With .Tables(1).Range.Columns.Borders(wdBorderHorizontal)
            .Visible = True
            .Color = wdColorGray125
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With

           'Traitement des lignes
            With .Tables(1).Range.Rows.Borders(wdBorderVertical)
                .Visible = True
                .Color = wdColorGray125
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth050pt
            End With
 End With
    
'Supprime la sélection dans Excel
Application.CutCopyMode = False
'Enregistre les modifications
DocWord.Save
Application.WindowState = xlNormal

  'Ferme le document
'AppWord.Application.Quit
End Sub

Résultat en image

​

 

[eddy1975]

Re : [Résolu] Éviter les boucles pour créer le tableau

Bonjour Lone-Wolf,

Poser des questions et se répondre à soi-même

C'est grave docteur ??

@+

 

[Lone-wolf]

Re : [Résolu] Éviter les boucles pour créer le tableau

Bonsoir eddy,

qu'est-ce que tu veux faire?! On devient vieux, on devient vieux; et parfois on va plus vite que la musique.