Discussion :

[Marc31]

Bonjour,

Je travaille sur des fichiers excel ou je fais des statistiques. Une fois terminé, je dois transferer les résultats des calculs dans des tableaux words.
Donc j'aimerais automatiser cette manip avec vba, j'ai deja fais le début mais pour placer les résultats dans les tableaux words je bloque. J'aimerais avoir un peu d'aide s'il vous plaît.

Voici le code:

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
 
Sub RemplirTableauWordDepuisDonnéesExcel()
 
 
     Dim AppWord As Word.Application
 
     Dim docword As Word.Document
 
     Set AppWord = New Word.Application
 
     Application.DisplayAlerts = True
 
     AppWord.ShowMe
 
     AppWord.Visible = True
 
     'Ouvre le document Word
 
     Set docword = AppWord.Documents.Open("R:\PREVENTION ET SECURITE\NOUVELLE STRUCTURE\TABLEAUX DE BORD\MODAT Indicateurs\Modat Ind en cours\Année 2011\Docs_pierre\test_vba\Fenouillet_test11.doc", ReadOnly:=False)
 
     ' Copie les données Excel
 
     Contrats_ISBN = Sheets("faits_constates").Range("C14").Value
 
     Contrats_Titre = Sheets("faits_constates").Range("D14").Value
 
     Contrats_autre = Sheets("coups_blessures").Range("B14").Value
 
 
     ' Colle les données dans Word
 
     docword.Tables(2).Rows.Add
 
     Derligne = docword.Tables(2).Rows.Count
 
 
     With docword.Tables(2)
 
          .Cell(Derligne, 1).Range.InsertAfter Contrats_ISBN
 
          .Cell(Derligne, 2).Range.InsertAfter Contrats_Titre
 
          .Cell(Derligne, 3).Range.InsertAfter Contrats_autre
 
 
     End With
 
     docword.Application.ActiveDocument.Save
 
     AppWord.Application.Quit
 
End Sub

Bonne journée

[Philippe Tulliez]

Bonjour,
Un petit tour dans la FAQ, Comment exporter des données Excel dans des cellules précises d'un tableau Word ? et aussi Comment exporter un tableau Excel vers Word et l'adapter à la largeur de la page ?
Je te conseille aussi une petite visite sur l'excellent site d'Eric Renaud et tout particulièrement à la rubrique OLE Automation où tu trouveras des exemples de code pour échanger de données entre Excel et Word.

[MattChess]

Bonjour peter11,

Le code fourni fonctionne à partir du moment où le document Word Test11.doc à compléter dispose de deux tables et que la seconde table a trois colonnes.

La première chose à faire dans Module1 d'Excel est de forcer la déclaration des variables par :

Code :

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

Option Explicit

Puis on doit décrire les deux feuilles Excel ainsi que le document Word.
Eviter les accents dans le nom de la procédure principale. Structurer en procédures courtes.

Dans la solution proposée, on a ajouté une gestion d'erreur ainsi qu'une copie de travail du document Word. Il est préférable de faire les modifications du document Word depuis Excel depuis une copie du document Word. Une fois que tout s'est bien passé, on fait la mise à jour du document final par une copie de fichier.

• C'est particulièrement important dans un contexte réseau où le document Word est distant.
• Même pour un document en local, la copie du document Word permet de préserver le document original mis à jour qu'à la fin.

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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Option Explicit ' Cellules d'Excel vers tableau Word en VBA
' VBE menu "Tools" > "References" [x] Microsoft Word 8.0 Object Library
' ============ Description de la feuille Excel ============
Public Const nameSheetFact = "faits_constates"
Public Const rowFactStat = 14
Public Const colFactIsbn = 3 ' Contrats ISBN
Public Const colFactTitle = colFactIsbn + 1 ' Contrats Titre
 
Public Const nameSheetBlow = "coups_blessures"
Public Const rowBlowStat = 14
Public Const colBlowOther = 2 ' Contrats autre
 
' ============ Description du document Word    ============
' VBE menu "Outils" > "Propriété de VBA Project" > "Arguments de compilation conditionnelle"
' isNetwork=1 pour un accès réseau. isNetwork=0 ou non défini pour un accès local
#If isNetwork = 1 Then
Public Const filenameDoc = "R:\PREVENTION ET SECURITE\NOUVELLE STRUCTURE\TABLEAUX DE BORD\MODAT Indicateurs\Modat Ind en cours\Année 2011\Docs_pierre\test_vba\Fenouillet_test11.doc"
#Else
' Test en local
Public Const filenameDoc = "C:\Users\You\Documents\Excel\Developpez\peter11\test11.doc"
#End If
Public Const isCopyDoc = True ' Copie le document dans un document temporaire
Public Const nameDocTmp = "Tmp.doc" ' Document Word temporaire de travail
Public Const indDocTableStat = 2 ' Seconde table dans le document
Public Const colDocIsbn = 1 ' Première colonne de la seconde table
Public Const colDocTitle = colDocIsbn + 1
Public Const colDocOther = colDocTitle + 1
 
Sub RemplirTableauWordDepuisDonneesExcel()
Dim wordApp As Word.Application, wordDoc As Word.Document, isDocSaved As Boolean
Dim contrats_ISBN As String, contrats_Titre As String, contrats_autre As String
Dim strNameDoc As String
    If isCopyDoc Then If Not WordCopy(filenameDoc, WordTmp()) Then Exit Sub
    Set wordApp = New Word.Application
    Application.DisplayAlerts = True
    wordApp.ShowMe
    wordApp.Visible = True
    strNameDoc = IIf(isCopyDoc, WordTmp(), filenameDoc)
    If WordOpen(strNameDoc, wordApp, wordDoc) Then
        With Sheets(nameSheetFact)  ' Copie les données Excel
            contrats_ISBN = .Cells(rowFactStat, colFactIsbn).Value
            contrats_Titre = .Cells(rowFactStat, colFactTitle).Value
        End With
        contrats_autre = Sheets(nameSheetBlow).Cells(rowBlowStat, colBlowOther).Value
        If WordTable(wordDoc, contrats_ISBN, contrats_Titre, contrats_autre) Then
            isDocSaved = WordSave(wordDoc, strNameDoc)
        End If
    End If
    wordApp.Quit
    If isCopyDoc Then
        If isDocSaved Then WordCopy WordTmp(), filenameDoc
'        On Error Resume Next: Kill WordTmp(): On Error GoTo 0 ' Delete the temporary doc
    End If
    Set wordApp = Nothing
End Sub
 
Function WordTmp() As String
    WordTmp = ThisWorkbook.Path + "\" + nameDocTmp
End Function
 
'Ouvre le document Word
Function WordOpen(ByVal strFilename As String, ByVal wordApp As Word.Application, _
            ByRef wordDoc As Word.Document) As Boolean
    WordOpen = False
    On Error Resume Next
    Set wordDoc = wordApp.Documents.Open(strFilename, ReadOnly:=False)
    If Err.Number <> 0 Then Warning "1000: Impossible d'ouvrir " + strFilename: Exit Function
    On Error GoTo 0
    WordOpen = True
End Function
 
Function WordSave(wordDoc As Word.Document, ByVal strFilename As String) As Boolean
    WordSave = False
    On Error Resume Next
    wordDoc.Application.ActiveDocument.Save
    If Err.Number <> 0 Then
        Warning "2000: Impossible de sauver " + strFilename: Exit Function
    End If
    On Error GoTo 0
    WordSave = True
End Function
 
Function WordCopy(ByVal strFileSrc As String, ByVal strFileDest As String) As Boolean
    On Error Resume Next
    FileCopy strFileSrc, strFileDest
    If Err.Number = 0 Then
        WordCopy = True
    Else
        Warning "3000: Impossible de copier " + strFileSrc + vbCrLf + _
                " dans " + strFileDest
        WordCopy = False
    End If
    On Error GoTo 0
End Function
 
' Remplir la table n° indDocTableStat du document
Function WordTable(wordDoc As Word.Document, ByVal contrats_ISBN As String, _
    ByVal contrats_Titre As String, ByVal contrats_autre As String) As Boolean
Dim lineLastDoc As Long
 
    WordTable = False
    If wordDoc.Tables.Count < indDocTableStat Then
        Warning "4000: Impossible de trouver la table n° " & indDocTableStat & _
                " dans le document Word"
        Exit Function
    End If
    With wordDoc.Tables(indDocTableStat) ' Colle les données dans Word
        .Rows.Add
        lineLastDoc = .Rows.Count ' la dernière ligne ajoutée
        .Cell(lineLastDoc, colDocIsbn).Range.InsertAfter contrats_ISBN
        .Cell(lineLastDoc, colDocTitle).Range.InsertAfter contrats_Titre
        .Cell(lineLastDoc, colDocOther).Range.InsertAfter contrats_autre
    End With
    WordTable = True
End Function
 
Sub Warning(ByVal strMsg As String) 'Common error management
Const lenErr = 4 ' Number of digits of the error code beginning the message
    If Err.Number <> 0 Then
        strMsg = strMsg + vbCrLf + "Error " + Str(Err.Number) + ": " + Err.Description
    End If
    MsgBox Mid(strMsg, lenErr + 3), vbExclamation, "Excel to Word warning " + Left(strMsg, lenErr)
End Sub

En cas d'erreur, le document Word original est préservé.
On a mis en commentaire l'effacement du document temporaire Tmp.doc.

Mettre un point d'arrêt dans RemplirTableauWordDepuisDonneesExcel() sans accent.
Dans la fenêtre d'Exécution immédiate (Ctrl+G) du VBE d'Excel, copier-coller et valider par ENTER :

Code :

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

RemplirTableauWordDepuisDonneesExcel

Test11.doc a sa seconde table avec une nouvelle ligne correspondant aux trois cellules ISBN, Titre et Autre, extraites des deux feuilles du classeur Excel.
___________

Si la discussion est résolue, vous pouvez cliquer sur le bouton

En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert ci-dessous.

[Marc31]

Bonjour et merci pour les réponses mais je n'arrive toujours pas à faire le code pour mettre dans les tableaux words, je voudrais mettre les résultats excel dans le tableau word numéro 2 et mettre un resultat dans la colonne 2 et cellule 2 du tableau word.Enfin j'essaye de mettre un exemple mais j'ai l'impression qu'il n'est pas clair?
J'ai mis un exemple de tableau word, là où il y a les vides je dois les remplires.

Bon week end et encore merci!