problème avec formula1

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:

---

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:

---

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

---

bonjour,

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

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

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