problème avec formula1 [Résolu]

hobine · 30/01/2012, 10h02

Bonjour, je veux créer une liste déroulante, mais j'ai un bug dans mon code ci-dessous que je n'arrive pas à débugger.
En effet, j'ai écrit 2 codes différents pour l’automatisation d'une liste déroulante mais même galère.
La première c'est propriété ou méthodes non gérées par cet objet
Le second code, se trouve voption, il est défini comme string mais il ne lit pas au dela d'une certaine valeur. comment contourner cela?

Une Âme sensible pourra t elle me sortir de cette galère?
Merci par 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
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
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
 
' mettre la macro pour générer les menus déroulants quand on click sur une ligne
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
 
    Dim nligne As Integer
    Dim ncol As Integer
    Dim head As String
    Dim flag_liste As Integer
    Dim i As Integer
    Dim j As Integer
 
 
 
 
 
 
 
    For i = 1 To 8  'attention ici i correspond à la colonne
        For j = 6 To 120
            adressname = "$" & LetCol(i) & "$" & Str(j)
            adressname = Replace(adressname, " ", "")
 
            If Target.Address = adressname Then
             'ajout de la colonne index
 
 
 
 
 
            'création des menus déroulants
                nligne = j
                ncol = i
                head = Cells(2, ncol).Value
                flag_liste = verifliste(head)
 
 
                If flag_liste = 1 Then
                    Call CreeMenuDeroulant(nligne, ncol, head)
                Else
                    GoTo suivant
                End If
            End If
suivant:
        Next j
    Next i
 
 
 
 
    ' Chargement des conditions d'essai
    ' Selon le cahier des charges:
    '   - si les huit premières colonnes sont renseignées alors on charge les conditions d'essai
    '   - sinon, on imprime un message d'erreur et on vide les cellules associées
    ' trouver la fonction qui convertit les entiers en lettres
    For i = 9 To 120
        For j = 6 To 120
            'attention, ici i -> colonne
            '               j -> ligne
            NomCol = LetCol(i)
            adressname2 = "$" & NomCol & "$" & Str(j)
            adressname2 = Replace(adressname2, " ", "")
            If Target.Address = adressname2 Then
                ' vérifier que les  colones 1 à 8 sont remplies
                flag = 0
                For icol = 1 To 8
                    If Cells(j, icol).Value <> "" Then
                        flag = flag + 1
                    End If
                Next icol
 
 
                If flag = 8 Then
                ' on recopie les conditions de l'essai
                    Call RempliEnduranceEssai(j, i)
                Else
                ' message d'erreur puis suppression de la ligne en cours
                    MsgBox "Le moteur n'a pas été renseigné dans la base de données Nouvelles_saisies. Contacter l'administrateur des bases de données"
                    MsgBox "incompatibilté entre l'effacement et la macro: à terminer"
              '      For icol = 1 To 8
              '          Cells(j, icol).Delete
              '      Next icol
                End If
 
 
            End If
        Next j
    Next i
 
End Sub
 
 
Function LetCol(NoCol)
     LetCol = Split(Cells(1, NoCol).Address, "$")(1)
End Function
 
 
Sub CreeMenuDeroulant(nligne As Integer, ncol As Integer, head As String)
    ' tout d'abord il faut récupérer le nom associé à la colonne choisie
    Dim voption As String
    Dim ncolliste As Integer
    Dim tmp() As String
    Dim lignedebut As Integer
 
    premiere_ligne = 4 ' dans le fichier liste, le premier élément des listes déroulantes
 
    ' récupération de la colonne de la liste qui correspond.
    ncolliste = ColonneListe(head)
    Set xlliste = ThisWorkbook.Worksheets("BDD_Listes")
    Set xlecriture = ThisWorkbook.Worksheets("Nouvelles_saisies")
 
 
    PremierMotCle = xlliste.Cells(premiere_ligne, ncolliste).Value
 
    flag_indirect = 0
 
 
    If ncolliste > 1 Then
        For icol = 1 To (ncolliste - 1)
            If xlliste.Cells(premiere_ligne, icol).Value = PremierMotCle Then
                flag_indirect = 1
            End If
        Next icol
    End If
 
    If flag_indirect = 0 Then
        ' simple liste
 
        ' voption = CreeList(head)
 
        listcol = ColonneListe(head)
 
        lignedebut = 4
 
        nlignes = ThisWorkbook.Worksheets("BDD_Listes").Range(ThisWorkbook.Worksheets("BDD_Listes").Cells(4, listcol), ThisWorkbook.Worksheets("BDD_Listes").Cells(4, listcol)).End(xlDown).Row
       ' ReDim tmp(nlignes - lignedebut)
        'For i = 0 To (nlignes - lignedebut)
      '          tmp(i) = ThisWorkbook.Worksheets("BDD_Listes").Cells(i + 4, listcol).Value
 
       ' Next i
 
 
 
        ThisWorkbook.Sheets("Nouvelles_saisies").Activate
        Cells(nligne, ncol).Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & ThisWorkbook.Worksheets("BDD_Listes").Range(ThisWorkbook.Worksheets("BDD_Listes").Cells(4, listcol), ThisWorkbook.Worksheets("BDD_Listes").Cells(nlignes, listcol)).adress
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = head
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    Else
 
        If xlecriture.Cells(nligne, ncol - 1).Value = "" Then
            MsgBox "Renseigner la case précédente"
            GoTo fin
        Else
            head = xlecriture.Cells(nligne, ncol - 1).Value
            voption = CreeListIndirecte(head, ncolliste)
            ThisWorkbook.Sheets("Nouvelles_saisies").Activate
        Cells(nligne, ncol).Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=voption
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = head
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        End If
    End If
 
 
 
 
 
 
fin:
 
 
End Sub
 
Function ColonneListe(NomListe As String)
'récupération de la colone qui contient l'entete NomListe
Dim ncol As Integer
Dim listcol As Integer
 
listcol = 0
Set wbk = ThisWorkbook
Set Sh = wbk.Sheets("BDD_Listes")
 
 
NomListe = Replace(NomListe, " ", "")
 
With Selection
    For ncol = 1 To 150
 
    Sh.Cells(2, ncol).WrapText = False
    tmp = Replace(Sh.Cells(2, ncol).Value, Chr(10), "")
' suppression des éventuels espaces résiduels
    tmp = Replace(tmp, " ", "")
    Sh.Cells(2, ncol).WrapText = True
 
    If tmp = NomListe Then
        listcol = ncol
    End If
    Next ncol
    If listcol = 0 Then
        MsgBox "Erreur, aucune liste ne correspond à la colonne sélectionnée"
    End If
End With
ColonneListe = listcol
 
 
End Function
 
 
 
 
Function CreeList(NomListe As String) As String
'cette fonction génère la liste des options d'une liste donnée
'exple pour la liste B elle va générer la chaîne de caractères "B1,B2,B3,B4,B5"
 
 
 
'récupération de la colone qui contient l'entete NomListe
listcol = ColonneListe(NomListe)
 
tmp = ""
lignedebut = 4
 
nlignes = ThisWorkbook.Worksheets("BDD_Listes").Range(ThisWorkbook.Worksheets("BDD_Listes").Cells(4, listcol), ThisWorkbook.Worksheets("BDD_Listes").Cells(4, listcol)).End(xlDown).Row
Dim tmp(nlignes - lignedebut) As String
For i = 0 To (nlignes + lignedebut - 1)
        tmp(i) = ThisWorkbook.Worksheets("BDD_Listes").Cells(i, listcol).Value
Next i
    'tmp = tmp & ThisWorkbook.Worksheets("BDD_Listes").Cells(i, listcol).Value
 
CreeList = Left(tmp, Len(tmp) - 1)
 
End Function
 
 
Function CreeListIndirecte(head As String, ncolliste As Integer)
    Dim tmp As String
 
    flag1 = 0
    flag2 = 0
    For i = 4 To 500
 
 
        If flag1 = 0 And flag2 = 0 And ThisWorkbook.Worksheets("BDD_Listes").Cells(i, ncolliste).Value = head Then
            flag1 = 1
            idebut = i + 1
        End If
        If flag1 = 1 And flag2 = 0 And ThisWorkbook.Worksheets("BDD_Listes").Cells(i, ncolliste).Value = "" Then
            flag2 = 1
            ifin = i - 1
        End If
    Next i
 
    tmp = ""
    For i = idebut To ifin
        tmp = tmp & ThisWorkbook.Worksheets("BDD_Listes").Cells(i, ncolliste).Value & ","
    Next i
 
        CreeListIndirecte = Left(tmp, Len(tmp) - 1)
End Function
 
 
Function verifliste(head As String) As Integer
    Dim flag As Integer
    Set wbk = ThisWorkbook
    Set Sh = wbk.Sheets("BDD_Listes")
 
    head = Replace(head, " ", "")
    flag = 0
    For i = 1 To 120
        'suppression de la mise en forme automatique
        Sh.Cells(2, i).WrapText = False
        ' suppression des retours chariot
        tmp = Replace(Sh.Cells(2, i).Value, Chr(10), "")
        ' suppression des éventuels espaces résiduels
        tmp = Replace(tmp, " ", "")
        If tmp = head Then
            flag = 1
        End If
        Sh.Cells(2, i).WrapText = True
    Next i
 
    verifliste = flag
 
 
End Function
 
 
Sub RempliEnduranceEssai(iligne As Integer, jcol As Integer)
 
Dim Plage As Range
Dim tbl() As Variant
Dim CombinaisonChoisie() As Variant
Dim lignerecuperee() As Variant
Set xlendurance = ThisWorkbook.Sheets("BDD_Endurance_Essai")
' à remplacer par la feuille saisie: A FAIRE
Set xlsaisie = ThisWorkbook.Sheets("Nouvelles_saisies")
 
With xlendurance
 Set Plage = .Range("A1:DV" & .Range("A36650").End(xlUp).Row)
End With
 
tbl = Plage.Value
 
nblignes = UBound(tbl, 1)
nbcol = UBound(tbl, 2)
 
 
ReDim CombinaisonChoisie(1 To 8)
ReDim lignerecuperee(1 To 8)
 
For icol = 1 To 8
    CombinaisonChoisie(icol) = xlsaisie.Cells(iligne, icol).Value
Next icol
 
 
 
numero_ligne_retenue = "vide"
For i = 1 To nblignes
    If tbl(i, 1) = CombinaisonChoisie(1) And tbl(i, 2) = CombinaisonChoisie(2) And tbl(i, 3) = CombinaisonChoisie(3) And tbl(i, 4) = CombinaisonChoisie(4) And tbl(i, 5) = CombinaisonChoisie(5) And tbl(i, 6) = CombinaisonChoisie(6) And tbl(i, 7) = CombinaisonChoisie(7) And tbl(i, 8) = CombinaisonChoisie(8) Then
        numero_ligne_retenue = i
    End If
Next i
 
 
If numero_ligne_retenue = "vide" Then
    MsgBox "La combinaison choisie ne correspond à aucun élément de la base de données endurance"
Else
With xlsaisie
    For num_col = 9 To 120
        Cells(iligne, num_col).Value = xlendurance.Cells(numero_ligne_retenue, num_col).Value
    Next num_col
End With
 
End If
 
 
End Sub

second 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
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
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
 
' mettre la macro pour générer les menus déroulants quand on click sur une ligne
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
 
    Dim nligne As Integer
    Dim ncol As Integer
    Dim head As String
    Dim flag_liste As Integer
    Dim i As Integer
    Dim j As Integer
 
 
 
 
 
 
 
    For i = 1 To 8  'attention ici i correspond à la colonne
        For j = 6 To 120
            adressname = "$" & LetCol(i) & "$" & Str(j)
            adressname = Replace(adressname, " ", "")
 
            If Target.Address = adressname Then
             'ajout de la colonne index
 
 
 
 
 
            'création des menus déroulants
                nligne = j
                ncol = i
                head = Cells(2, ncol).Value
                flag_liste = verifliste(head)
 
 
                If flag_liste = 1 Then
                    Call CreeMenuDeroulant(nligne, ncol, head)
                Else
                    GoTo suivant
                End If
            End If
suivant:
        Next j
    Next i
 
 
 
 
    ' Chargement des conditions d'essai
    ' Selon le cahier des charges:
    '   - si les huit premières colonnes sont renseignées alors on charge les conditions d'essai
    '   - sinon, on imprime un message d'erreur et on vide les cellules associées
    ' trouver la fonction qui convertit les entiers en lettres
    For i = 9 To 120
        For j = 6 To 120
            'attention, ici i -> colonne
            '               j -> ligne
            NomCol = LetCol(i)
            adressname2 = "$" & NomCol & "$" & Str(j)
            adressname2 = Replace(adressname2, " ", "")
            If Target.Address = adressname2 Then
                ' vérifier que les  colones 1 à 8 sont remplies
                flag = 0
                For icol = 1 To 8
                    If Cells(j, icol).Value <> "" Then
                        flag = flag + 1
                    End If
                Next icol
 
 
                If flag = 8 Then
                ' on recopie les conditions de l'essai
                    Call RempliEnduranceEssai(j, i)
                Else
                ' message d'erreur puis suppression de la ligne en cours
                    MsgBox "Le moteur n'a pas été renseigné dans la base de données Nouvelles_saisies. Contacter l'administrateur des bases de données"
                    MsgBox "incompatibilté entre l'effacement et la macro: à terminer"
              '      For icol = 1 To 8
              '          Cells(j, icol).Delete
              '      Next icol
                End If
 
 
            End If
        Next j
    Next i
 
End Sub
 
 
Function LetCol(NoCol)
     LetCol = Split(Cells(1, NoCol).Address, "$")(1)
End Function
 
 
Sub CreeMenuDeroulant(nligne As Integer, ncol As Integer, head As String)
    ' tout d'abord il faut récupérer le nom associé à la colonne choisie
    Dim voption As String
    Dim ncolliste As Integer
 
 
 
    premiere_ligne = 4 ' dans le fichier liste, le premier élément des listes déroulantes
 
    ' récupération de la colonne de la liste qui correspond.
    ncolliste = ColonneListe(head)
    Set xlliste = ThisWorkbook.Worksheets("BDD_Listes")
    Set xlecriture = ThisWorkbook.Worksheets("Nouvelles_saisies")
 
 
    PremierMotCle = xlliste.Cells(premiere_ligne, ncolliste).Value
 
    flag_indirect = 0
 
 
    If ncolliste > 1 Then
        For icol = 1 To (ncolliste - 1)
            If xlliste.Cells(premiere_ligne, icol).Value = PremierMotCle Then
                flag_indirect = 1
            End If
        Next icol
    End If
 
    If flag_indirect = 0 Then
        ' simple liste
 
         voption = CreeList(head)
 
        ThisWorkbook.Sheets("Nouvelles_saisies").Activate
        Cells(nligne, ncol).Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=voption
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = head
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    Else
 
        If xlecriture.Cells(nligne, ncol - 1).Value = "" Then
            MsgBox "Renseigner la case précédente"
            GoTo fin
        Else
            head = xlecriture.Cells(nligne, ncol - 1).Value
            voption = CreeListIndirecte(head, ncolliste)
            ThisWorkbook.Sheets("Nouvelles_saisies").Activate
        Cells(nligne, ncol).Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=voption
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = head
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        End If
    End If
 
 
 
 
 
 
fin:
 
 
End Sub
 
Function ColonneListe(NomListe As String)
'récupération de la colone qui contient l'entete NomListe
Dim ncol As Integer
Dim listcol As Integer
 
listcol = 0
Set wbk = ThisWorkbook
Set Sh = wbk.Sheets("BDD_Listes")
 
 
NomListe = Replace(NomListe, " ", "")
 
With Selection
    For ncol = 1 To 150
 
    Sh.Cells(2, ncol).WrapText = False
    tmp = Replace(Sh.Cells(2, ncol).Value, Chr(10), "")
' suppression des éventuels espaces résiduels
    tmp = Replace(tmp, " ", "")
    Sh.Cells(2, ncol).WrapText = True
 
    If tmp = NomListe Then
        listcol = ncol
    End If
    Next ncol
    If listcol = 0 Then
        MsgBox "Erreur, aucune liste ne correspond à la colonne sélectionnée"
    End If
End With
ColonneListe = listcol
 
 
End Function
 
 
 
 
Function CreeList(NomListe As String) As String
'cette fonction génère la liste des options d'une liste donnée
'exple pour la liste B elle va générer la chaîne de caractères "B1,B2,B3,B4,B5"
Dim tmp As String
 
'récupération de la colone qui contient l'entete NomListe
listcol = ColonneListe(NomListe)
 
tmp = ""
lignedebut = 4
 
nlignes = 500
For i = lignedebut To nlignes
      If ThisWorkbook.Worksheets("BDD_Listes").Cells(i, listcol).Value <> "" Then
        tmp = tmp & ThisWorkbook.Worksheets("BDD_Listes").Cells(i, listcol).Value & ","
    End If
Next i
 
CreeList = Left(tmp, Len(tmp) - 1)
 
End Function
 
 
Function CreeListIndirecte(head As String, ncolliste As Integer)
    Dim tmp As String
 
    flag1 = 0
    flag2 = 0
    For i = 4 To 500
 
 
        If flag1 = 0 And flag2 = 0 And ThisWorkbook.Worksheets("BDD_Listes").Cells(i, ncolliste).Value = head Then
            flag1 = 1
            idebut = i + 1
        End If
        If flag1 = 1 And flag2 = 0 And ThisWorkbook.Worksheets("BDD_Listes").Cells(i, ncolliste).Value = "" Then
            flag2 = 1
            ifin = i - 1
        End If
    Next i
 
    tmp = ""
    For i = idebut To ifin
        tmp = tmp & ThisWorkbook.Worksheets("BDD_Listes").Cells(i, ncolliste).Value & ","
    Next i
 
        CreeListIndirecte = Left(tmp, Len(tmp) - 1)
End Function
 
 
Function verifliste(head As String) As Integer
    Dim flag As Integer
    Set wbk = ThisWorkbook
    Set Sh = wbk.Sheets("BDD_Listes")
 
    head = Replace(head, " ", "")
    flag = 0
    For i = 1 To 120
        'suppression de la mise en forme automatique
        Sh.Cells(2, i).WrapText = False
        ' suppression des retours chariot
        tmp = Replace(Sh.Cells(2, i).Value, Chr(10), "")
        ' suppression des éventuels espaces résiduels
        tmp = Replace(tmp, " ", "")
        If tmp = head Then
            flag = 1
        End If
        Sh.Cells(2, i).WrapText = True
    Next i
 
    verifliste = flag
 
 
End Function
 
 
Sub RempliEnduranceEssai(iligne As Integer, jcol As Integer)
 
Dim Plage As Range
Dim tbl() As Variant
Dim CombinaisonChoisie() As Variant
Dim lignerecuperee() As Variant
Set xlendurance = ThisWorkbook.Sheets("BDD_Endurance_Essai")
' à remplacer par la feuille saisie: A FAIRE
Set xlsaisie = ThisWorkbook.Sheets("Nouvelles_saisies")
 
With xlendurance
 Set Plage = .Range("A1:DV" & .Range("A36650").End(xlUp).Row)
End With
 
tbl = Plage.Value
 
nblignes = UBound(tbl, 1)
nbcol = UBound(tbl, 2)
 
 
ReDim CombinaisonChoisie(1 To 8)
ReDim lignerecuperee(1 To 8)
 
For icol = 1 To 8
    CombinaisonChoisie(icol) = xlsaisie.Cells(iligne, icol).Value
Next icol
 
 
 
numero_ligne_retenue = "vide"
For i = 1 To nblignes
    If tbl(i, 1) = CombinaisonChoisie(1) And tbl(i, 2) = CombinaisonChoisie(2) And tbl(i, 3) = CombinaisonChoisie(3) And tbl(i, 4) = CombinaisonChoisie(4) And tbl(i, 5) = CombinaisonChoisie(5) And tbl(i, 6) = CombinaisonChoisie(6) And tbl(i, 7) = CombinaisonChoisie(7) And tbl(i, 8) = CombinaisonChoisie(8) Then
        numero_ligne_retenue = i
    End If
Next i
 
 
If numero_ligne_retenue = "vide" Then
    MsgBox "La combinaison choisie ne correspond à aucun élément de la base de données endurance"
Else
With xlsaisie
    For num_col = 9 To 120
        Cells(iligne, num_col).Value = xlendurance.Cells(numero_ligne_retenue, num_col).Value
    Next num_col
End With
 
End If
 
 
End Sub

jfontaine · 30/01/2012, 23h27

bonjour,

Heureusement qu'il n'y a pas beaucoup de lignes de code

Si au moins tu nous indiquerais les lignes posant problème

hobine · 31/01/2012, 09h43

Bonjour Jérôme,
je suis désole de ma réaction tardive. Pour répondre à ta question, les lignes 147 et 157 respectivement pour le premier et second code.

Je te mets le fichier en PJ et ma macro se trouve sur vba de la feuille Nouvelles_saisie. A l'ouverture de mon fichier, tu auras un bug , c'est normal puisque tu ne disposeras pas de tous les éléments nécessaires. cependant la correction du bug est indépendant du reste.

Cordialement

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email