Discussion :

[budyraptor]

Bonjour à tous,

première info, je ne connais pas du tout les langages mais j'ai besoin de créer un (une ) macro sous excel.

Je vais essayer de bien m'expliquer et de vous faire comprendre ce que je désire faire.

Dans mon tableau et dans une cellule il faudrait que lorsque je coche une case cela me génère un fichier Word avec un texte prédéfini.

Admettons que mon tableau possède 50 lignes avec pour chacune une case à cocher qui génère un fichier Word personnalisé.

mieux des mots une image :



j'ai bien trouver ce code qui fonctionne

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub ECRIRE_word()
 Dim MonWord As Object
  Set MonWord = CreateObject("Word.Application")
   ' Création d'un nouveau document :
  MonWord.Documents.Add
  ' Ecriture d'un petit texte dans ce nouveau document :
  MonWord.Selection.TypeText "Tester écriture dans word depuis excel"
  ' Sauvegarde de ce document ainsi créé :
  MonWord.ActiveDocument.SaveAs "C:\test.doc"
  ' Fermeture de ce document :
  MonWord.ActiveDocument.Close
  Set MonWord = Nothing
End Sub

mais ensuite..... suis largué

Merci de vos retour.

[Menhir]

A priori, cette macro fait ce que tu décris.
Tu sembles souhaiter qu'elle en fasse plus mais tu ne décris rien sur ce "plus".

[budyraptor]

je voulais y aller par étape,

oui tu as raison, je désire que cela me créer un Word avec le texte voulu et avec une mise en forme.

A savoir
une image



puis texte

Titre
Réf:
texte

etc.

[Menhir]

Dans ce cas, le plus simple est de faire un fichier Word "gabarit", contenant déjà tes chapitres avec la bonne mise en forme repérés par des signets.
Il suffit ensuite d'ouvrir ce gabarit et de remplacer les signets (bookmark en VBA) par les valeurs des cellules puis de sauvegarder sous un nom différent (pour ne pas écraser le gabarit).

Il y a eut récemment un sujet comparable ici : https://www.developpez.net/forums/d1...ts-mise-forme/
Tu peux t'en inspirer.

[budyraptor]

Merci mais suis largué autant sous Word, par contre j'ai trouvé ce code qui ferait mon bonheur si le tableau fonctionnait aussi
peux-tu me dire se qui cloche s'il te plait
merci

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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
Option Explicit
 
' ***********************************************************************
' *****                                                             *****
' *****        CODE PierreP56 : <a href="http://tatiak.canalblog.com/" target="_blank">http://tatiak.canalblog.com/</a>        *****
' *****                                                             *****
' ***********************************************************************
 
 
Public Const wdAlignParagraphLeft = 0
Public Const wdAlignParagraphCenter = 1
Public Const wdAlignParagraphRight = 2
Public Const wdAlignParagraphJustify = 3
 
Public Const wdPageBreak = 7
 
Public Const wdBorderTop = -1
Public Const wdBorderLeft = -2
Public Const wdBorderBottom = -3
Public Const wdBorderRight = -4
 
 
Sub Creer_Word()
Dim WordApp As Object, WordDoc As Object, Rng As Object
Dim Rep As String, Ndf As String, Logo As String
Dim i As Integer, j As Integer
Dim Total As Single
 
    On Error GoTo errhdlr
    'Rep = Application.DefaultFilePath & "\\SERVEURRSARCHI\Desktop\Word\"
    Rep = "\\SERVEURRSARCHI\Desktop\Word\"
    If Not Exist_Rep(Rep) Then MkDir Rep
 
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Add
    Ndf = Rep & "Fiche_" & Format(Now(), "yyyyMMdd_hhmm") & ".docx"
 
    With WordDoc
        ' Mise en page : Marges
        With .PageSetup
            .LeftMargin = WordApp.CentimetersToPoints(1.5)
            .RightMargin = WordApp.CentimetersToPoints(1.5)
            .TopMargin = WordApp.CentimetersToPoints(2)
            .BottomMargin = WordApp.CentimetersToPoints(2)
        End With
 
        ' Ajoute un logo s'il existe (fichier mon image.png placé sur le bureau)
        Logo = "\\SERVEURRSARCHI\Desktop\mon image.png"
        If Exist_Fichier(Logo) Then
            .Paragraphs.Add
            .InlineShapes.AddPicture (Logo)
        End If
 
        ' Ajoute MON TITRE
        .Paragraphs.Add
        With .Paragraphs(.Paragraphs.Count - 1)
            .Range.Text = "MON TITRE"
            .Range.Font.Bold = True
            .Range.Font.Underline = True
            .Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
            .Format.SpaceAfter = 18
            .Range.InsertAfter (vbCrLf) ' ou bien .Range.InsertParagraphAfter()
        End With
 
        ' Ajoute un titre
        .Paragraphs.Add
        With .Paragraphs(.Paragraphs.Count - 1)
            .Range.Text = "Cahier des clauses techniques particulières"
            .Range.Font.Bold = True
            .Range.Font.Underline = True
            .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Format.SpaceAfter = 18
            .Range.InsertAfter (vbCrLf) ' ou bien .Range.InsertParagraphAfter()
        End With
 
         ' Ajoute un sous-titre
        .Paragraphs.Add
        With .Paragraphs(.Paragraphs.Count - 1)
            .Range.Text = "CCTP"
            .Range.Font.Bold = True
            .Range.Font.Underline = True
            .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Format.SpaceAfter = 18
            .Range.InsertAfter (vbCrLf) ' ou bien .Range.InsertParagraphAfter()
        End With
 
 
        ' Ajoute un signet
        .Paragraphs.Add
        With .Paragraphs(.Paragraphs.Count - 1)
            .Range.Font.Bold = False
            .Range.Font.Underline = False
            .Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
            Set Rng = WordDoc.Range(Start:=.Range.Start, End:=.Range.Start)
        End With
        .Bookmarks.Add Range:=Rng, Name:="Signet1"
 
        ' ajoute le(s) paragraphe(s) de la colonne A si coché(s) en colonne B
        For i = 2 To 17
            If ActiveSheet.Range("B" & i) = "x" Then
                .Paragraphs.Add
                With .Paragraphs(.Paragraphs.Count - 1)
                    .Range.Text = ActiveSheet.Range("A" & i)
                    .Range.Font.Bold = False
                    .Range.Font.Underline = False
                    .Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
                    .Range.ParagraphFormat.FirstLineIndent = WordApp.CentimetersToPoints(1.25)
                    .Format.SpaceAfter = 8
                    .Range.InsertAfter (vbCrLf)
                End With
            End If
        Next i
 
        ' passe une ligne
        .Paragraphs.Add
 
        ' insère un saut de page
        .Paragraphs(.Paragraphs.Count - 1).Range.InsertBreak Type:=wdPageBreak
 
        ' passe une ligne
        .Paragraphs.Add
 
 
        ' Ajoute un tableau de 3 lignes (les lignes suivantes sont créées en fonction des besoins)
 
        '------------------------------------------------------------------------------------------------------
        'JE DESIRE QUE LE TABLEAU S INCREMENTE AUTOMATIQUEMENT AUX NOMBRES DE LIGNES OU LA COLONNE B EST COCHEE
        '------------------------------------------------------------------------------------------------------
        .Paragraphs.Add
        With .Paragraphs(.Paragraphs.Count - 1)
            .Range.Font.Bold = False
            .Range.Font.Underline = False
            .Format.SpaceBefore = 2
            .Format.SpaceAfter = 2
            Set Rng = WordDoc.Range(Start:=.Range.Start, End:=.Range.Start)
        End With
 
        With .Tables.Add(Range:=Rng, NumRows:=3, NumColumns:=5)
            ' ajuste la largeur des colonnes
            .Columns.Item(1).Width = WordApp.CentimetersToPoints(8)
            .Columns.Item(2).Width = WordApp.CentimetersToPoints(1.8)
            .Columns.Item(3).Width = WordApp.CentimetersToPoints(1.8)
            .Columns.Item(4).Width = WordApp.CentimetersToPoints(1.8)
            .Columns.Item(5).Width = WordApp.CentimetersToPoints(3)
 
            ' fusionne les cases de la ligne 1 et ajoute un titre au tableau
            For i = 1 To 3
                .cell(1, 1).Merge MergeTo:=.cell(1, 2)
            Next i
            With .cell(1, 1)
                .Range.Text = "Devis Quantitatif Estimatif"
                .Range.Shading.BackgroundPatternColor = -738132071
                .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Range.Font.Bold = True
                .Borders.Enable = True
            End With
 
            ' complète et formate les entêtes
            For j = 1 To 5
                With .cell(2, j)
                    .Range.Text = ActiveSheet.Cells(1, j + 3)
                    .Range.Shading.BackgroundPatternColor = -603923969 '-738132071
                    .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                    .Range.Font.Bold = True
                    .Borders.Enable = True
            '        .Borders(wdBorderTop).LineStyle = 1
            '        .Borders(wdBorderLeft).LineStyle = 1
            '        .Borders(wdBorderRight).LineStyle = 1
            '        .Borders(wdBorderBottom).LineStyle = 1
                End With
            Next j
 
           ' complète et formate les lignes de données
            Total = ActiveSheet.Cells(2, "H").Value
            For i = 3 To 7
                For j = 1 To 5
                    With .cell(i, j)
                        .Range.Text = ActiveSheet.Cells(i - 1, j + 3).Text
                        .Borders.Enable = True
                        '.Borders(wdBorderTop).LineStyle = 1
                        '.Borders(wdBorderLeft).LineStyle = 1
                        '.Borders(wdBorderRight).LineStyle = 1
                        '.Borders(wdBorderBottom).LineStyle = 1
                    End With
                Next j
 
                ' aligne les données
                .cell(i, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .cell(i, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .cell(i, 4).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .cell(i, 5).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
 
                ' totalise les montants
                Total = Total + ActiveSheet.Cells(i, "H").Value
 
                ' ajoute la ligne suivante
                .Rows.Add
            Next
 
            For j = 1 To 2
                .cell(i + 1, 1).Merge MergeTo:=.cell(i + 1, 2)
            Next j
            With .cell(i + 1, 1)
                .Borders(wdBorderLeft).LineStyle = 0
                .Borders(wdBorderRight).LineStyle = 0
                .Borders(wdBorderBottom).LineStyle = 0
            End With
            ' Inscrit le total final en gras, en rouge et au format monétaire
            .cell(i + 1, 2).Range.Text = "Total :"
            .cell(i + 1, 2).Range.Font.Bold = True
            .cell(i + 1, 2).Range.Font.Color = RGB(200, 10, 10)
            .cell(i + 1, 2).Borders(wdBorderLeft).LineStyle = 1
            .cell(i + 1, 3).Range.Text = Format(Total, "# ###.00 €")
            .cell(i + 1, 3).Range.Font.Bold = True
            .cell(i + 1, 2).Range.Font.Color = RGB(200, 10, 10)
        End With
 
        ' dernier paragraphe : "Edité le"
        .Paragraphs.Add
        With .Paragraphs(.Paragraphs.Count - 1)
            .Range.Text = "Edité le : " & Format(Now(), "dd/MM/yyyy HH:mm")
            .Range.Font.Italic = True
            .Range.Font.Underline = False
            .Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        End With
 
    End With
 
    WordDoc.Application.ActiveDocument.SaveAs (Ndf)
    WordApp.Visible = True  ' ou bien => WordApp.Application.Quit
 
    Set Rng = Nothing
    Set WordDoc = Nothing
    Set WordApp = Nothing
 
    MsgBox "Document Word généré!"
    Exit Sub
 
errhdlr:
    Set Rng = Nothing
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Debug.Print Err.Description
End Sub
 
 
Function Exist_Rep(Ndf As String) As Boolean
    On Error Resume Next
    Exist_Rep = GetAttr(Ndf) And vbDirectory
End Function
 
 
Function Exist_Fichier(S As String) As Boolean
Dim tatiak As Object
 
    Set tatiak = CreateObject("Scripting.FileSystemObject")
    Exist_Fichier = tatiak.FileExists(S)
    Set tatiak = Nothing
End Function

mon problème est que le tableau généré dans Word ne s'incrémente pas automatiquement en fonction des lignes qui sont cochées ou non dans la colonne B


le résultat actuel est :

[Menhir]

Merci mais suis largué autant sous Word

Tu as passé moins de 10 min pour essayer de comprendre la méthode décrite.
Autant dire que tu n'as aucune intention d'être actif sur la résolution de ton problème et que tu espères que d'autres fassent tout à ta place.
Personnellement, ce genre d'agissement m’agace. Je pense donc que je ne vais pas aller plus loin.

Bonne chance pour la suite.