Discussion :

[memns]

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

model Finding Seats VersAide.xlsm SIN-ENG-P04-F02_maintenance_work_sheet_ANNEX Revision 1.docx

[memns]

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 :

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
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 !

[Menhir]

Code :

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

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

Ou bien

Code :

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

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.

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.

[memns]

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 :

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
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

[memns]

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

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
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

[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.