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

  • Initiateur de la discussion Initiateur de la discussion Lone-wolf
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

Dernière édition:
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

Tableau-Word.gif
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
594
Retour