Automatisation d'export de donnees variables d'une feuille Excel sur un document Word via des signets

Version imprimable

20/07/2019, 21h34
memns

2 pièce(s) jointe(s)

Automatisation d'export de donnees variables d'une feuille Excel sur un document Word via des signets

Bonjour à tous,

Etant un novice dans le codage VBA et ayant survole en quantite la plupart des discussions faisant allusion a mon type de probleme je n'en ai jamais trouve de similaire c'est pourquoi je me permets d'ouvrir une nouvelle discussion afin d'avoir des aides exterieures.

Je vous decris le probleme :

J'ai un document Word (que vous trouverez ci-joint) se decomposant en 3 parties : Findings / Defective(s) parts requires / WORK PERFORMED.
J'ai assigne a chaque ligne un signet nommé : Signet1, Signet2, Signet3 etc jusqu'a Signet35.
Les Signet1 a Signet11 relatif aux lignes de la partie Findings, les Signet12 a Signet 22 relatif aux lignes de la partie Defective(s) parts required et Signet 23 a Signet35 relatif aux lignes de la partie Work performed.
J'ai un fichier Excel (que vous trouverez egalement ci-joint) ou se trouve la feuille qui nous interesse : la feuille Finding report. Elle contient les donnees que je souhaite copier dans mon document Word a partir de la ligne 21.

Pour donner un exemple concret :

Je souhaite concatener les donnees contenues dans les cellules A21, B21, C21 et F21 puis ensuite les assigner/copier au Signet1. De meme pour les donnees des cellules A22, B22, C22 et F22 pour le Signet2 et ainsi de suite jusqu'au Signet11 tout en evitant de copier les lignes ou les cellules A,B,C et F seraient vides car ce tableau de donnees est amene a changer pour chaque nouveau lancement de la macro. Tout en sachant que mon tableau de donnes commencera toujours a la ligne 21 de la feuille Finding report.
Etant donne qu'il n'y a que 11 lignes et donc 11 signets composant la partie Findings du document Word, j'aimerai savoir s'il est possible que des que mon code remarque qu'il a atteint le Signet11 et qu'il reste encore par la suite des donnees a copier (cellules A,B,C et F non vides) il recree un nouveau fichier word (identique a celui ci-joint) en continuant le travail, prealablement realise, sur la partie Findings de mon "2e document Word" et ainsi de suite jusqu'a copier les dernieres cellules non vides A,B,C et F de mon tableau de donnes.

Pour la suite, concernant la partie Defective parts required, j'aimerai qu'il remarque les valeurs des cellules G identiques (debutant a la ligne 21, comme explique plus haut) et qu'il attribue la valeur "qui se repete" concatenee (espacé tel que "" ":" "") a toutes les valeurs des cellules A correspondantes au Signet12 (pour l'exemple ci-joint "Normal Wear and tear : 1, 3, 8, 9, 10 etc.) et ainsi de suite pour toutes valeurs differentes possibles de la cellule G (si non vide). Sachant qu'il ne peut y avoir que 4 valeurs differentes pour la cellule G.

Et pour finir dans la partie Work performed, j'aimerai savoir s'il est possible d'attribuer a chaque Signet du 23 a 35 la cellule A suivie du mot "New" puis de la valeur de la cellule C et suivi du mot "installed". Evidemment comme precedemment cela debutera pour les cellules A21 et C21 dont les valeur seront copies sur le Signet23 et ainsi de suite jusqu'au Signet35 tout en ne prenant pas en compte les lignes vides. Et comme precedemment le nombre de cellules A et C non vides seront forcement plus important que le nombre de signets (13) contenus dans la partie Work performed, il faudrait etre capable de creer un nouveau document Word en poursuivant le travail sur la nouvelle partie Work performed jusqu'a avoir copie les dernieres cellules A et C non vide du tableau de donnees.

Il est aussi utile de preciser que quand bien meme je parlais de cellule vide elle ne le seront pas veritablement car le vide provient du resultat de plusieurs formules inscrites dans les cellules A, B, C et F de chaque ligne debutant a la ligne 21.

En cas de mauvaise explication de ma part n'hesitez surtout pas a me le communiquer peut etre me suis-je mal exprime.

Toute aide partielle sera evidemment la bienvenue etant donne mon niveau novice en VBA et en codage en general! :)

Merci d'avance

Pièce jointe 492584 Pièce jointe 492585

Incrementation de la ligne de la prochaine cellule non vide d'une colonne

Re les developpeurs

Y'aurait-il une âme charitable pour m'expliquer mon erreur ?

Je vous joins mon code qui bloque dans ce Sub : Private Sub CopierDonneesPartieFindings().
Plus précisément sur cette ligne : LigneProchaineCelluleNonVide = Range("Cells(j, 12)").End(xlDown).Row.
Et par consequent fait capoter le paragraphe qui suit et conclut ce Sub ...

Code:

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
Private Sub ConcatenerFindings()
 
Dim j As Byte
Dim NumeroDerniereLigneCelluleNonVide As Integer
 
With Sheets("Finding report")
 
NumeroDerniereLigneCelluleNonVide = Range("A300").End(xlUp).Row
 
'AdresseDerniereCelluleNonVide = Range("A21:A300").Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious)
'NumeroDerniereLigneCelluleNonVide = AdresseDerniereCelluleNonVide.Row 'Range("A" & NoLigne).End(xlUp).Row
'Cells(400, 1).End(xlUp).Row
'Range.Find("*", Range("A20"), xlValues, xlPart, xlByRows, xlPrevious, False).Value
'Range("A600").End(xlUp).Row
 
 For j = 21 To NumeroDerniereLigneCelluleNonVide
 
    If Cells(j, 1) <> "" Then
     .Cells(j, 12) = .Cells(j, 1) & "" & "" & "" & .Cells(j, 2) & "" & "" & "" & .Cells(j, 3) & "" & "" & "" & .Cells(j, 6)
 
    Else
    .Cells(j, 12) = ""
 
    End If
 
 Next j
 
End With
 
End Sub
 
Private Sub CopierDonneesPartieFindings()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i, j As Byte
Dim LigneProchaineCelluleNonVide As Integer
Dim DerniereCelluleNonVide As Range
'Dim CelluleConcateneeActuelle As Range
Dim ValeurProchCelluleNonVide As Variant
 
i = 1
j = 21
 
Set WordApp = CreateObject("word.application") 'ouvre session word
Set WordDoc = WordApp.Documents.Open("C:\Users\Utilisateur\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") 'ouvre document Word
 
With Sheets("Finding Report")
 
Do While Cells(j, 12) <> ""
        WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 12)
        i = i + 1
        j = j + 1
Loop
 
For i = i To 11
 
    'CelluleConcateneeActuelle = Cells(j, 12)
    LigneProchaineCelluleNonVide = Range("Cells(j, 12)").End(xlDown).Row
    DerniereCelluleNonVide = Range(LigneProchaineCelluleNonVide, 12)
    ValeurProchCelluleNonVide = DerniereCelluleNonVide.Value
    WordDoc.Bookmarks("Signet" & i).Range.Text = ValeurProchCelluleNonVide
    j = LigneProchaineCelluleNonVide
 
Next i
 
'ValeurProchCelluleNonVide = Column(12).Find("*", Range("Cells(j, 12)"), xlValues, , 2, 1, 0).Value
'WordDoc.Bookmarks("Signet" & i).Range.Text = Column(12).Find("*", Range("ValeurProchCelluleNonVide.Adress"), xlValues, , 2, 1, 0).Value
'Range("A20:A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Copy
'WordDoc.Bookmarks("Signet" & i).PasteSpecial (xlPasteValues)
 
End With
 
End Sub
 
Private Sub ConcatenerDefectivePartsRequired()
 
With Sheets("Finding report")
 
Dim CelluleReference As Variant
Dim ReceptionsConcatenees As String
Dim Reference As String
Dim j, X, k As Byte
 
j = 21
X = 1
k = 21
 
DerniereLigneNonVide = Range("G" & Rows.Count).End(xlUp).Row
Set PlageReference = Range(Cells(21, 7), Cells(DerniereLigneNonVide, 7))
CelluleReceptionsConcatenees = Cells(k, 14)
CelluleReference = Cells(j, 7)
 
Reference1 = "Normal wear & tear"
Reference2 = "Misuse/mishandeling"
Reference3 = "SUP"
Reference4 = "FOD"
 
For X = 1 To 4
For Each CelluleReference In PlageReference
        If CelluleReference = ("Reference" & X) & CelluleReference <> "" Then
            CelluleReceptionsConcatenees = CelluleReceptionsConcatenees & CelluleReference.Offset(0, -6) & " / "
        End If
Next CelluleReference
k = k + 1
Next X
 
End With
 
End Sub
 
Private Sub CopierDonneesDefectivePartsRequired()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i, j As Byte
 
Set WordApp = CreateObject("word.application") 'ouvre session word
Set WordDoc = WordApp.Documents.Open("C:\Users\MOUNSI\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") 'ouvre document Word
 
With Sheets("Finding Report")
 
i = 12
j = 21
 
Do While Cells(j, 14) <> ""
        WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 14)
            If i = 22 Then
                Exit Do
            End If
        i = i + 1
        j = j + 1
Loop
 
End Sub
 
Private Sub ConcatenerWorkPerformed()
 
Dim j As Byte
 
With Sheets("Finding report")
 
NumeroDerniereLigneCelluleNonVide = Cells(Rows.Count, 3).End(xlUp).Row
'Range.Find("*", Range("A20"), xlValues, xlPart, xlByRows, xlPrevious, False).Value
'Range("A600").End(xlUp).Row
 
 For j = 21 To NumeroDerniereLigneCelluleNonVide
 
    If Cells(j, 3) <> "" Then
     .Cells(j, 16) = "New" & .Cells(j, 3) & "installed"
 
    Else
    .Cells(j, 16) = ""
 
 Next j
 
End With
 
End Sub
 
Private Sub CopierDonneesWorkPerformed()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i, j As Byte
 
i = 23
j = 21
 
Set WordApp = CreateObject("word.application") 'ouvre session word
Set WordDoc = WordApp.Documents.Open("C:\Users\MOUNSI\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") 'ouvre document Word
 
With Sheets("Finding Report")
 
Do While Cells(j, 16) <> ""
        WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 16)
        i = i + 1
        j = j + 1
Loop
 
For i = i To 35
 
AdresseDerniereCelluleNonVide = Worksheets("Finding report").Range("Cells(j, 16):L").Find("*", , xlValues, , , xlPrevious)
ValeurProchCelluleNonVide = AdresseDerniereCelluleNonVide.Value
WordDoc.Bookmarks("Signet" & i).Range.Text = ValeurProchCelluleNonVide
j = AdresseDerniereCelluleNonVide.Row
 
Next i
 
'ValeurProchCelluleNonVide = Column(12).Find("*", Range("Cells(j, 12)"), xlValues, , 2, 1, 0).Value
'WordDoc.Bookmarks("Signet" & i).Range.Text = Column(12).Find("*", Range("ValeurProchCelluleNonVide.Adress"), xlValues, , 2, 1, 0).Value
'Range("A20:A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Copy
'WordDoc.Bookmarks("Signet" & i).PasteSpecial (xlPasteValues)
 
End With
 
End Sub
 
Sub ExportdonneesversWord()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i As Byte
Dim j As Byte
 
Set WordApp = CreateObject("word.application") 'ouvre session word
Set WordDoc = WordApp.Documents.Open("C:\Users\MOUNSI\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") 'ouvre document Word
 
WordApp.Visible = True 'word masqué pendant l'operation
 
While WordDoc.Bookmarks("Signet11").Range.Text = ""
    ConcatenerFindings '
    CopierDonneesPartieFindings '
Wend
 
While WordDoc.Bookmarks("Signet22").Range.Text = ""
    ConcatenerDefectivePartsRequired '
    CopierDonneesDefectivePartsRequired '
Wend
 
While WordDoc.Bookmarks("Signet35").Range.Text = ""
    ConcatenerWorkPerformed '
    CopierDonneesWorkPerformed '
Wend
 
'If WordDoc.Bookmarks("Signet11").Range.Text <> "" Then
    'Set WordApp = CreateObject("word.application") 'ouvre session word
    'Set WordDoc = WordApp.Documents.Open("C:\Users\MOUNSI\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") 'ouvre document Word
    'Concatener '
    'CopierDonneesPartieFindings '
'End If
 
 
WordApp.Visible = True 'affiche le document Word
 
 
 
'WordDoc.PrintOut 'imprimer
 
'WordDoc.Close True 'ferme le document word en sauvegardant les données
'WordApp.Quit 'ferme la session Word
 
End Sub

Je ne sais pas comment indiquer que pour chaque boucle de mon For, je viendrai chercher le nouveau j de la prochaine cellule non vide (sauf initialement où j prendra la valeur donne par la sortie de la boucle While juste avant) afin que ma formule : Range("Cells(j, 12)").End(xlDown).Row vienne trouver la prochaine et que par suite le j sera remplacé par la valeur de la ligne de la nouvelle cellule trouve non vide (dans la colonne L) à l'aide de Range("Cells(j, 12)").End(xlDown).Row ...

J'en ai besoin car il se peut qu'il y'ait beaucoup de cellules vides entre 2 cellules non vides selon les extractions.

Et si par ailleurs vous remarquez d'autres erreurs de débutant dans la suite du code (qui n'est pas encore terminé surtout concernant le main Sub voir faux à certains endroits) ne vous privez pas :) votre aide me serait précieuse

Merci d'avance !

23/07/2019, 16h09
Menhir

Code:

LigneProchaineCelluleNonVide = Cells(j, 12).End(xlDown).Row

Ou bien

Code:

LigneProchaineCelluleNonVide = Range("L" & j).End(xlDown).Row

La prochaine fois, pense à indiquer le message d'erreur renvoyé par le débugage.
Et essaye de nettoyer ton code (les lignes en commentaire) avant de le proposer sur le forum.

Citation:

Et si par ailleurs vous remarquez d'autres erreurs de débutant dans la suite du code (qui n'est pas encore terminé surtout concernant le main Sub voir faux à certains endroits) ne vous privez pas votre aide me serait précieuse

Sois plus concis dans le nom de tes variables.
Ces noms à rallonge rendent le code difficilement lisible.

Rebonjour,

Merci encore pour ta reponse Menhir cela marchait par la suite mais j'ai trouve un moyen plus simple de realiser ce que je voulais faire avec une boucle Do While True !

Je suis encore bloque par contre ...

J'ai reimbrique tout mes sub en un seul Sub afin que la copie des donnees depuis Excel se fassent sur le meme Word et non sur 3 Word differents comme ce qui etait le cas dans mon ancien code plus haut.

Le probleme est qu'il me copie les donnees pour la partie Findings mais que les 2 parties suivantes de mon Word (Defective Parts Required et Work Performed) restent vides ... Je ne comprends pas car j'ai pourtant tout assemble sous le meme WordDoc et mes signets sont notes sous la forme Signet1,Signet2,Signet3 tel qu'exprimes dans mon code (cf les parties : "Signet" & i).

Vous trouverez mon code reajuste ci-dessous.

Si quelqu'un a une idee je suis preneur je suis bloque mais mon code ne me fournit aucun message d'erreur ..

Merci d'avance !

Code:

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
Private Sub ConcatenerFindings()
 
Dim i, j, X, k As Byte
Dim NumeroDerniereLigneCelluleNonVide As Integer
Dim DerniereLigneNonVide As Integer
Dim CelluleReference As Variant
Dim CelluleReceptionsConcatenees As String
Dim Reference As String
 
With Sheets("Finding report")
 
j = 21
NumeroDerniereLigneCelluleNonVide = Range("A300").End(xlUp).Row
 
For j = 21 To NumeroDerniereLigneCelluleNonVide
 
    If Cells(j, 1) <> "" Then
     .Cells(j, 12) = .Cells(j, 1) & "" & .Cells(j, 2) & "" & .Cells(j, 3) & "" & .Cells(j, 6)
 
    Else
    .Cells(j, 12) = ""
 
    End If
 
 Next j
 
 
j = 21
X = 1
k = 21
 
DerniereLigneNonVide = Range("G300").End(xlUp).Row
Set PlageReference = Range(Cells(21, 7), Cells(DerniereLigneNonVide, 7))
CelluleReceptionsConcatenees = Cells(k, 14)
CelluleReference = Cells(j, 7)
 
Reference1 = "Normal wear & tear"
Reference2 = "Misuse/mishandeling"
Reference3 = "SUP"
Reference4 = "FOD"
Reference5 = "Mandatory Replacement"
 
For X = 1 To 5
For Each CelluleReference In PlageReference
        If CelluleReference = ("Reference" & X) & CelluleReference <> "" Then
            CelluleReceptionsConcatenees = CelluleReceptionsConcatenees & CelluleReference.Offset(0, -6) & " / "
        End If
Next CelluleReference
k = k + 1
Next X
 
 
 
'Range.Find("*", Range("A20"), xlValues, xlPart, xlByRows, xlPrevious, False).Value
'Range("A600").End(xlUp).Row
 
 For j = 21 To NumeroDerniereLigneCelluleNonVide
 
    If Cells(j, 3) <> "" Then
     .Cells(j, 16) = "New" & .Cells(j, 3) & "installed"
 
    Else
    .Cells(j, 16) = ""
    End If
 
 Next j
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
 
i = 1
j = 21
 
Set WordApp = CreateObject("word.application") 'ouvre session word
Set WordDoc = WordApp.Documents.Open("C:\Users\MOUNSI\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx")
 
Do While True
    If Cells(j, 12) <> "" Then
        WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 12)
        i = i + 1
    End If
    j = j + 1
    If j = 300 Or i = 12 Then
        Exit Do
    End If
Loop
 
i = 12
j = 21
 
Do While True
    If Cells(j, 14) <> "" Then
        WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 14)
        i = i + 1
    End If
    j = j + 1
    If i = 23 Or j = 30 Then
        Exit Do
    End If
Loop
 
i = 23
j = 21
 
Do While True
    If Cells(j, 16) <> "" Then
        WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 16)
        i = i + 1
    End If
    j = j + 1
    If j = 300 Or i = 36 Then
        Exit Do
    End If
Loop
 
WordApp.Visible = True
 
End With
 
End Sub

Plus précisément au niveau de ce bout de code (trouve par logique et grâce à la fonction pas à pas) :
Code:

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 Dim i, j, X, k As Byte Dim NumeroDerniereLigneCelluleNonVide As Integer Dim DerniereLigneNonVide As Integer Dim CelluleReference As Variant Dim CelluleReceptionsConcatenees As String Dim Reference As String With Sheets("Finding report") j = 21 X = 1 k = 21 DerniereLigneNonVide = Range("G300").End(xlUp).Row Set PlageReference = Range(Cells(21, 7), Cells(DerniereLigneNonVide, 7)) CelluleReceptionsConcatenees = Cells(k, 14) CelluleReference = Cells(j, 7) Reference1 = "Normal wear & tear" Reference2 = "Misuse/mishandeling" Reference3 = "SUP" Reference4 = "FOD" Reference5 = "Mandatory Replacement" For X = 1 To 5 For Each CelluleReference In PlageReference If CelluleReference = ("Reference" & X) & CelluleReference <> "" Then CelluleReceptionsConcatenees = CelluleReceptionsConcatenees & CelluleReference.Offset(0, -6) & " / " End If Next CelluleReference k = k + 1 Next X
Les conditions : If CelluleReference = ("Reference" & X) & CelluleReference <> "" ne sont pas respectées ...

La référence ne prend pas la valeur, en fonction de la valeur de X, des différentes références initialises plus haut et même dans le cas ou la variable CelluleReference est vide la variable CelluleReceptionsConcatenees prend quand même la valeur CelluleReference.Offset(0, -6).

De plus même en sortant de la boucle For Each, ma variable CelluleReceptionConcatenees ne s'incrémente pas et ne passe pas à la cellule N22 alors que j'ai inscrit k = k + 1 je ne sais pas pourquoi la variable va rester sur la même cellule et continuer à prendre les valeurs CelluleReference.Offset(0, -6).

Si quelqu'un peut m'éclairer sur mes erreurs et la démarche à effectuer,

Merci d'avance

24/07/2019, 12h53
Menhir

Le "&" n'est pas un opérateur logique, c'est un opérateur de concaténation de chaine de caractère.
Il ne peut en aucun cas remplacer l'opérateur And.

Les libertés qu'on peut prendre dans le langage courant ne sont plus acceptable quand on utilise un langage informatique.

Au temps pour moi grossiere erreur de ma part merci Menhir mais pour autant cela n'a pas impacte dans le bon sens cette partie du code.
Meme en enlevant la 2eme partie du If cela ne fonctionne toujours pas (car celle-ci etait finalement contre productive)

La boucle du If ne realise toujours pas que pour chaque cellule dans la plage il lui faut comparer la valeur de la cellule actuelle avec la Reference1 (=Normal wear & tear) et que si les 2 valeurs concordent => il faut ainsi venir attribuer a la variable CelluleReceptionConcatenees la valeur de la cellule (j,"A") et ce pour toutes les cellules de la plage de reference.
Et faire de meme pour chacunes des 5 références d'où le : For X = 1 To 5.

Cette fois ci la condition du If se fait passer systématiquement alors que selon moi il n'y a pas raison a ce que cela se passe.
Selon moi soit le ("Reference" & X) n'est pas une bonne maniere d'introduire une incrementation des references soit j'ai fait une erreur dans mes dim mais ce n'est pas forcement ca

Par ailleurs il n'y a toujours pas de message d'erreur mais rien ne s'affiche dans mes signets 12 a 22 lorsque je compile mon code ...

Ci-joint le code de cette partie
Code:

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 Private Sub ConcatenerFindings() Dim i, j, X, k As Byte Dim DerniereLigneNonVide As Integer Dim CelluleReference As Variant Dim CelluleReceptionsConcatenees As String Dim Reference As String With Sheets("Finding report") j = 21 X = 1 k = 21 DerniereLigneNonVide = Range("G300").End(xlUp).Row Set PlageReference = Range(Cells(21, 7), Cells(DerniereLigneNonVide, 7)) CelluleReceptionsConcatenees = Cells(k, 14) CelluleReference = Cells(j, 7) Reference1 = "Normal wear & tear" Reference2 = "Misuse/mishandeling" Reference3 = "SUP" Reference4 = "FOD" Reference5 = "Mandatory Replacement" For X = 1 To 5 For Each CelluleReference In PlageReference If CelluleReference = ("Reference" & X) Then CelluleReceptionsConcatenees = CelluleReceptionsConcatenees & CelluleReference.Offset(0, -6) & " / " Else End If Next CelluleReference k = k + 1 Next X Dim WordApp As Word.Application Dim WordDoc As Word.Document Set WordApp = CreateObject("word.application") 'ouvre session word Set WordDoc = WordApp.Documents.Open("C:\Users\Utilisateur\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") 'ouvre document Word i = 12 j = 21 Do While True If Cells(j, 14) <> "" Then WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 14) i = i + 1 End If j = j + 1 If i = 23 Or j = 30 Then Exit Do End If Loop WordApp.Visible = True End With End Sub
Si quelqu'un a une idee merci d'avance :)

Citation:

Envoyé par memns

Au temps pour moi grossiere erreur de ma part merci Menhir mais pour autant cela n'a pas impacte dans le bon sens cette partie du code.

Dans la mesure où ça n'aurait pas fonctionné sans cette modification, je pense contrairement à toi que ça a un impact.
Mais comme il y a plusieurs erreurs dans ton code, corriger une erreur ne garantit pas que va fonctionner.

Je viens de comprendre ce que représentait pour toi les "Reference" : tu essayes de bricoler une sorte de macro variable ?
Oula ! Il y a certains langages comme Nantuket ou certains C qui permettent ça mais avec VBA ça n'est pas possible.

Il faut indicer les variables si on veut les utiliser avec... un indice.

En plus, du point de vue VBA, deux variables nommées Reference et Reférence1, ça n'a aucun rapport.
Même si nos cerveaux humains à logique floue font le rapprochement, pour l'informatique, il n'y a aucun lien implicite.

Un conseil : mets toujours un Option Explicit avant ton premier Sub dans tes codes, ça t'obligera à déclarer tes variables et ça mettra en évidence ce type de maladresse.
Ou, mieux, rend-le systématique avec Outils > Options > Déclaration de variables obligatoire.

Juste un résumé (tu ajouteras ce que j'ai omis) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Dim Reference(5) As String Reference(1) = "Normal wear & tear" Reference(2) = "Misuse/mishandeling" Reference(3) = "SUP" Reference(4) = "FOD" Reference(5) = "Mandatory Replacement" For X = 1 To 5 For Each CelluleReference In PlageReference If CelluleReference.Value = Reference(X) Then CelluleReceptionsConcatenees.Value = CelluleReceptionsConcatenees.Text & CelluleReference.Offset(0, -6).Text & " / " End If Next CelluleReference Next X
Quelques petits détails au passage : ton Else ne servait à rien, tout comme le k = k + 1.

Oui je comprends mais dans mon cas la double condition n'etait pas necessaire car j'attendais juste que la CelluleReference = Reference(X) et non qu'elle soit differente du vide sinon ma variable CelluleReceptionsConcatenees aurait pris des valeurs non attendues je pense.

Oui en effet ce sera une macro variable car dans le fichier excel nommé "Modele Findings Seats" joint a mon 1er message (vous trouverez aussi le document Word dans lequel les donnees devront etre copiees) le tableau de donnees de la feuille "Finding report" variera et donc son nombre de lignes par la meme occasion, toutefois en commencant toujours a la ligne 21. Ce tableau ne devrait cependant jamais depasser plus de 300 lignes.

Merci pour le code et il est vrai que je doutais de la veracité de mon ("Reference" & X) mais je ne savais pas comment reproduire mon idee sur VBA maintenant cela est plus clair.

Cependant avec votre nouveau code j'ai dimensionne la variable CellulesReceptionsConcatennes as Range car selon moi c'est une adresse de cellule mais le code ne se compile pas et me donne l'erreur 91 : "Variable Objet ou variable Bloc With non définie" en me precisant la ligne 20, je ne comprends pas ce refus auriez vous une idee ? (J'ai essaye tous types de variables : Range, Variant, Object, String etc. meme si cela n'etait pas coherent afin d'avoir un apercu mais toujours refusé)

J'ai aussi une 2nde question : pourquoi le k = k + 1 n'etait pas necessaire ?
Selon moi lors de la 1ere boucle de For Each ce dernier incrementera la variable CelluleReference pour chaque adresse de la variable PlageReference et lorsqu'il trouvera que la CelluleReference = Reference(1) alors il attribuera le texte de la cellule (j,"A") a la valeur de la variable CelluleReceptionsConcatenees.
Cependant sans ajouter k = k + 1 a la fin de de la 1ere boucle du For Each ma variable CelluleReceptionsConcatenees ne prendra pas une nouvelle cellule (impacte par la variable k) et les valeurs des cellules (j,"A") relative a l'egalite CelluleReference = Reference(2) viendront se rajouter dans la meme cellule et ainsi de suite jusqu'a la Reference(5) non ?
Or je veux qu'apres Reference(1) la variable CelluleReceptionsConcatenees "saute une ligne" a partir de la cellule "N21" pour ensuite pouvoir assigner chaque cellule a mes signets 12 a 17 comme dans la 2eme partie de mon code ci-joint (car il n'y aura que 5 references comme initialise dans le code) ou me trompé-je ?
Code:

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 Option Explicit Private Sub ConcatenerFindings() Dim i, j, X, k As Byte Dim DerniereLigneNonVide As Integer Dim CelluleReference As Variant Dim CelluleReceptionsConcatenees As Range Dim Reference(5) As String Dim PlageReference As Range With Sheets("Finding report") j = 21 X = 1 k = 21 DerniereLigneNonVide = Range("G300").End(xlUp).Row Set PlageReference = Range(Cells(21, 7), Cells(DerniereLigneNonVide, 7)) CelluleReceptionsConcatenees = Cells(k, 14) CelluleReference = Cells(j, 7) Reference(1) = "Normal wear & tear" Reference(2) = "Misuse/mishandeling" Reference(3) = "SUP" Reference(4) = "FOD" Reference(5) = "Mandatory Replacement" For X = 1 To 5 For Each CelluleReference In PlageReference If CelluleReference.Value = Reference(X) Then CelluleReceptionsConcatenees.Value = CelluleReceptionsConcatenees.Text & CelluleReference.Offset(0, -6).Text & " / " Else End If Next CelluleReference 'k = k + 1 Next X Dim WordApp As Word.Application Dim WordDoc As Word.Document Set WordApp = CreateObject("word.application") 'ouvre session word Set WordDoc = WordApp.Documents.Open("C:\Users\Utilisateur\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") 'ouvre document Word i = 12 j = 21 Do While True If Cells(j, 14) <> "" Then WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 14) i = i + 1 End If j = j + 1 If i = 23 Or j = 30 Then Exit Do End If Loop WordApp.Visible = True End With End Sub

25/07/2019, 08h56
Menhir

Citation:

Envoyé par memns

Oui je comprends mais dans mon cas la double condition n'etait pas necessaire car j'attendais juste que la CelluleReference = Reference(X) et non qu'elle soit differente du vide sinon ma variable CelluleReceptionsConcatenees aurait pris des valeurs non attendues je pense.

Ton test tel qu'il était avec le "&" n'aurait pas fonctionné.
Mais je vais arrêter de polémiquer sur ce sujet : si tu penses que ça aurait quand même fonctionné, remets-le et tu verras.

Citation:

dans le fichier excel nommé "Modele Findings Seats" joint a mon 1er message (vous trouverez aussi le document Word dans lequel les donnees devront etre copiees)

Je n'ouvre pas les fichiers joints, entre autre pour les raisons expliquées ici : https://www.developpez.net/forums/d8...s-discussions/

Citation:

Cependant avec votre nouveau code j'ai dimensionne la variable CellulesReceptionsConcatennes as Range car selon moi c'est une adresse de cellule mais le code ne se compile pas et me donne l'erreur 91 : "Variable Objet ou variable Bloc With non définie" en me precisant la ligne 20

Pour assigner une variable objet, il faut utiliser l'instruction Set.
https://docs.microsoft.com/fr-fr/off.../set-statement

Citation:

J'ai aussi une 2nde question : pourquoi le k = k + 1 n'etait pas necessaire ?

J'ai une meilleure question : pourquoi serait-ce nécessaire étant donné que cette variable n'est jamais utilisée par la suite ?
Mettre une valeur dans une variable n'a d'intérêt que si par la suite tu utilise cette valeur.

Citation:

Cependant sans ajouter k = k + 1 a la fin de de la 1ere boucle du For Each ma variable CelluleReceptionsConcatenees ne prendra pas une nouvelle cellule (impacte par la variable k)

Il n'y a pas de relation entre ces deux variables.
CelluleReceptionsConcatenees a pour valeur Cells(21, 14).
Même si elle est renseignée à l'origine par Cells(k, 14), si k change par la suite, CelluleReceptionsConcatenees ne changera pas si elle n'est pas réassignée.

Citation:

Ton test tel qu'il était avec le "&" n'aurait pas fonctionné.
Mais je vais arrêter de polémiquer sur ce sujet : si tu penses que ça aurait quand même fonctionné, remets-le et tu verras.

Oui exact je suis totalement d'accord avec toi je voulais juste preciser (et non polemiquer) que j'avais fait une erreur car elle etait contre productive dans mon raisonnement et que cela etait de ma faute initialement de l'avoir integre a mon code lol

Citation:

Pour assigner une variable objet, il faut utiliser l'instruction Set.
https://docs.microsoft.com/fr-fr/off.../set-statement

Citation:

Il n'y a pas de relation entre ces deux variables.
CelluleReceptionsConcatenees a pour valeur Cells(21, 14).
Même si elle est renseignée à l'origine par Cells(k, 14), si k change par la suite, CelluleReceptionsConcatenees ne changera pas si elle n'est pas réassignée.

Je te remercie grace a tes commentaires j'ai reussi a sortir exactement le rendu que je cherchais concernant cette partie !

Cependant je me retrouve a tester mes 2 autres parties plus simples que la derniere evoquee mais elle ne fonctionne pas en raison d'une mauvaise attribution de la valeur de ma variable NumeroDerniereLigneCelluleNonVide (nomme identique dans les 2 sub mais j'ai teste independamment les 2 sub pour savoir si le rendu etait tel que je le voulais).

J'ai respectivement dans mon 1er et 2eme sub defini cette variable tel que :
Code:

1 2 NumeroDerniereLigneCelluleNonVide = Range("A300").End(xlUp).Row NumeroDerniereLigneCelluleNonVide = Range("C300").End(xlUp).Row
Afin qu'elle me renvoie le numero de la ligne contenant la derniere cellule non vide des colonnes A et C en partant a chaque fois de la ligne 300.
Cependant dans le 1er cas elle me renvoie 20 alors que (code ci-joint) ma boucle For debute a 21 ce qui implique que ma boucle est saute mais le code tourne sans que les signets de la partie Findings soient remplaces par la valeur voulu ...
Et dans le 2eme cas elle me renvoie 520 (encore plus etrange) ... et un message d'erreur "Overflow" apparait

Je ne comprends pas alors que dans mon tableau Excel feuille "Finding report" la derniere cellule non vide pour les colonnes A et C est 41.
Cela est surement du aux resultats qui composent ces cellules A et C, devrais-je utiliser la methode Find ? sinon je ne vois pas ..

Si vous avez une idee je suis preneur, merci d'avance :D
Code:

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 Option Explicit Private Sub ConcatenerFindings() Dim i, j, X, k As Byte Dim NumeroDerniereLigneCelluleNonVide As Integer With Sheets("Finding report") j = 21 NumeroDerniereLigneCelluleNonVide = Range("A300").End(xlUp).Row For j = 21 To NumeroDerniereLigneCelluleNonVide If Cells(j, 1) <> "" Then .Cells(j, 12) = .Cells(j, 1) & "" & .Cells(j, 2) & "" & .Cells(j, 3) & "" & .Cells(j, 6) Else .Cells(j, 12) = "" End If Next j Dim WordApp As Word.Application Dim WordDoc As Word.Document Set WordApp = CreateObject("word.application") 'ouvre session word Set WordDoc = WordApp.Documents.Open("C:\Users\MOUNSI\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") i = 1 j = 21 Do While True If Cells(j, 12) <> "" Then WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 12) i = i + 1 End If j = j + 1 If j = 300 Or i = 12 Then Exit Do End If Loop End With End Sub
Code:

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 Option Explicit Private Sub ConcatenerWorkPerformed() Dim i, j As Byte Dim NumeroDerniereLigneCelluleNonVide As Integer Dim WordApp As Word.Application Dim WordDoc As Word.Document Set WordApp = CreateObject("word.application") 'ouvre session word Set WordDoc = WordApp.Documents.Open("C:\Users\MOUNSI\Desktop\SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx") With Sheets("Finding report") NumeroDerniereLigneCelluleNonVide = Range("C300").End(xlUp).Row For j = 21 To NumeroDerniereLigneCelluleNonVide If Cells(j, 3) <> "" Then .Cells(j, 16) = " New " & .Cells(j, 3) & " installed " Else .Cells(j, 16) = "" End If Next j i = 23 j = 21 Do While True If Cells(j, 16) <> "" Then WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(j, 16) i = i + 1 End If j = j + 1 If j = 300 Or i = 36 Then Exit Do End If Loop WordApp.Visible = True End With End Sub