Discussion :

[dragonflyhood]

Bonjour,

Je ne sais pas du tout utiliser les macros ( enfin le code VBA)et j'aimerais pouvoir générer un fichier word automatique (basé sur un modèle) pour chaque ligne de mon fichier excel avec les infos souhaitées. Tout est expliqué dans mon fichier en pièce jointe.

Merci beaucoup pour votre aide précieuse.

Cdt,

Dragonfly

[kiki29]

Salut, c'est l'occasion de te mettre au VBA
Créer des champs dans ton Doc Word ou Modele ( extension dotx )
Puis voir Piloter Word depuis Excel
Puis si tu as des problèmes tu pourras revenir à ce moment là.

[dragonflyhood]

re,
merci pour votre aide, néanmoisn pourriez-vous juste me montrer le code qui me permet d'ouvrir le word avec le contenu de ma base de données (pour une ligne par exemple)?
Merci infiniment.

Cordialement.
Max (dragonflyhood)

[kiki29]

Re, dans La FAQ Piloter Word depuis Excel, il y a ceci : Comment écrire et lire dans un champ Word ?

Cependant pour que tu n'aies pas de références à cocher, utilise ceci et adapte le à ton contexte :

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
Option Explicit
 
Sub Donnees_ChampWord()
Dim WordApp As Object
Dim WordDoc As Object
 
    'ouvre session word
    Set WordApp = CreateObject("Word.Application")
    'ouvre du document Word
    Set WordDoc = WordApp.Documents.Open("C:\monFichier.doc")
    'word est masqué pendant l'opération
    WordApp.Visible = False
 
 
    'Fields(1) : premier champ du document Word
    'Insertion du contenu de la cellule A1 dans le champ.
    WordDoc.Fields(1).Result.Text = Range("A1")
 
    'Si le champ est dans un entête, utilisez:
    'WordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Fields(1).Result.Text
 
    'Récupère le contenu du champ
    MsgBox WordDoc.Fields(1).Result.Text
 
    'Ferme le document word en sauvegardant les modifications
    WordDoc.Close True
    'ferme la session Word
    WordApp.Quit
End Sub

[kiki29]

Re, ton code devrait ressembler à qqch comme ceci :
Sinon il y a ceci pour les Bookmarks/Signets , à adapter

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
Option Explicit
 
Sub Remplir_ChampWord()
Dim WordApp As Object
Dim WordDoc As Object
Dim i As Long, j As Long, LastRow As Long
 
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
 
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False
 
    For i = 2 To LastRow
        Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\" & "Suivi projet.doc")
        For j = 1 To 8
            WordDoc.Fields(j).Result.Text = Trim$(Feuil1.Cells(i, j))
        Next j
        WordDoc.SaveAs Filename:=ThisWorkbook.Path & "\Test\" & "SP " & Format(i - 1, "000") & ".doc"        
        Set WordDoc = Nothing
    Next i
 
    WordApp.Quit
    Set WordApp = Nothing
End Sub

En créant une plage nommée "Liste" sur A2:A16
On peut lancer la génération des docs d'une sélection contiguë ou non
de cellules dans cette plage nommée

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
Option Explicit
 
Sub Remplir_ChampsWord_Selection()
Dim WordApp As Object
Dim WordDoc As Object
Dim iCol As Long
Dim Cel As Range, Inter As Range
 
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False
 
    For Each Cel In Selection.Cells
        Set Inter = Application.Intersect(Cel, Feuil1.[Liste])
        If Not Inter Is Nothing Then
            Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\" & "Modele.doc")
            For iCol = 1 To 8
                WordDoc.Fields(iCol).Result.Text = Trim$(Feuil1.Cells(Cel.Row, iCol))
            Next iCol
            WordDoc.SaveAs Filename:=ThisWorkbook.Path & "\Test\" & "SP " & Format(Cel.Row - 1, "000") & ".doc"
            Set WordDoc = Nothing
        End If
    Next Cel
 
    WordApp.Quit
    Set WordApp = Nothing
 
    Feuil1.Range("A1").Select
End Sub