Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Lone-wolf

XLDnaute Barbatruc
Bonjour à tous


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

Code:
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?
 

Pièces jointes

  • Copie Tableau-Word.zip
    40.2 KB · Affichages: 64
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
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.

Code:
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

 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
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.
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…