erreur 457

[georgioGD]

Salut le forum

Je suis de retour avec une erreur qui s'affiche au démarrage de mon application " Stock".
qui est la suivante
erreur 457
cette clé est déjà associée à un élément de cette collection
Cette application marchait bien auparavant ? lorsque je vais voir mon vba avec debug la ligne suivante est coloriée "Nodupes.add cell.value,STr(cell.value)"
Je ne comprends pas donc si quelq'un sait rectifier l'erreur .
Merci d'avance à tous

 

[fred65200]

Re : erreur 457

bonjour,

tu ne peux pas ajouter deux éléments identiques à un collection.
Tu essaies d'en ajouter un qui existe déjà
Place on error resume next avant l'ajout à la collection
et Err.clearn error goto 0 après.

Tiens nous au courant

fred65200

 

[fred65200]

Re : erreur 457

On error resume next
Nodupes.add cell.value,STr(cell.value)
Err.clear: on error goto 0

c'est mieux comme ça

 

[georgioGD]

Re : erreur 457

bonsoir Fred5200 et merci pour ton intérêt à mon problême.
Voici une partie de mon vba incriminé

Sub Ajout_FournisseurDA()
Dim Dernier
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer, D As Integer
Dim Swap1, Swap2, Item

'1 AJOUT FOURNISSEUR DANS LISTE Fournisseur FRM_DA
Worksheets("DA-Cde").Select
Dernier = Range("A5").End(xlDown).Offset(0, 15).Address
' Les éléments sont dans P2ernier
Set AllCells = Range("P2:" & Dernier)
' L'instruction suivante ignore l'erreur due à la tentative
' d'ajout d'une clé dupliquée à la collection.
' Le duplicata n'est pas ajouté - c'est exactement ce que l'on souhaite !
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note : le 2e argument (key) pour la méthode Add doit être une chaîne
Next Cell
' Reprise gestion normal des erreurs
On Error GoTo 0

' Trie la collection (optionnel)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Ajoute les éléments stockés non dupliqués à une zone de liste
For Each Item In NoDupes
FRM_Cde.CBX_Fournisseur.AddItem Item
Next Item
For D = 1 To NoDupes.Count
NoDupes.Remove 1
Next D
End Sub

 

[fred65200]

Re : erreur 457

bonsoir,

j'ai essayé ta macro, pas de bug chez moi,
les données s'ajoute au ComboBox CBX_Fournisseur de FRM_Cde.

Peux tu "uploader" ton classeur sans donnée personnelle.

@+

 

[wilfried_42]

Re : erreur 457

Bonjour à tous

Le probleme vient bien de la mais ne sera pas forcement resolu car il a ete provoqué par autre chose

Quand tu lances ta macro, tu crées des collections, que tu supprimes à la fin
quant tu crées ta collection et que ca plante parce qu'elle existe deja, c'est que la suppression à la fin de ta macro ne s'est pas faite

Alors soit tu as fait une manoeuvre volontaire pour arreter ta macro en cours soit à un moment donnée elle s'est plantée

 

[georgioGD]

Re : erreur 457

Merci fred5200 et wilfried_42 vous êtes toujours aussi formidable sur ce forum , je vais voir ce que je peux faire avec vos conseils si vous avez de nouvelles idées je suis preneur Merci encore!

 

[fred65200]

Re : erreur 457

bonsoir Wilfried_42, giorgioGd

wilfried_42, ta réflexion est pleine de bon sens.

Je m'en veux de ne pas y avoir pensé, surtout que j'ai déjà été confronté à ce problème.

Salutations

 

[georgioGD]

Re : erreur 457

RE SLT
J'essaie de trouver le pourquoi du comment ,mais à chq fois que je boucle et que cell est = au tour precedent il m'affiche ce grogneuneu de s!!!!!!!!!!!!!!!!!!!!!! de message et jene comprends pas à 100% ce qui ce passe alors si vous pouvez me guider Tank you very much

 

[fred65200]

Re : erreur 457

Hi GeorgioGD

essaie ça en debut de code

On error resume next
For D = 1 To NoDupes.Count
NoDupes.Remove 1
Next D
on error goto 0

@+

 

[georgioGD]

Re : erreur 457

Hello fred65200
Peux tu placer ton code dans l'extrait que je t'ai envoyer svp car moi je vois pas !
Merci encore et encore

 

[fred65200]

Re : erreur 457

voila

Sub Ajout_FournisseurDA()
Dim Dernier
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer, D As Integer
Dim Swap1, Swap2, Item

On error resume next
For D = 1 To NoDupes.Count
NoDupes.Remove 1
Next D
on error goto 0

'1 AJOUT FOURNISSEUR DANS LISTE Fournisseur FRM_DA
Worksheets("DA-Cde").Select
Dernier = Range("A5").End(xlDown).Offset(0, 15).Address
' Les éléments sont dans P2ernier
Set AllCells = Range("P2:" & Dernier)
' L'instruction suivante ignore l'erreur due à la tentative
' d'ajout d'une clé dupliquée à la collection.
' Le duplicata n'est pas ajouté - c'est exactement ce que l'on souhaite !
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note : le 2e argument (key) pour la méthode Add doit être une chaîne
Next Cell
' Reprise gestion normal des erreurs
On Error GoTo 0

' Trie la collection (optionnel)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Ajoute les éléments stockés non dupliqués à une zone de liste
For Each Item In NoDupes
FRM_Cde.CBX_Fournisseur.AddItem Item
Next Item
For D = 1 To NoDupes.Count
NoDupes.Remove 1
Next D
End Sub



@+ fred65200

 

[georgioGD]

Re : erreur 457

Desole fred65200 mais cela ne fonctionne toujours pa s. Je ne comprends pas car je n'ai touché à rien et avant cela fonctionnait trés bien ? koi kil en soit je vous remercie tous

 

[Luki]

Re : erreur 457

bonsoir, georgio, fred, wilfried le fil,

En passant, ça me rappelle un truc similaire avec un pb de gestion d'erreur dans ou hors d'une boucle.

A essayer : placer ta gestion d'erreur dans la boucle

for each....
on error resume next
le code
next
on error goto 0

Car il me semble que l'erreur n'est pas réinitialisée sinon... Mais sans garantie.

A+

 

[fred65200]

Re : erreur 457

Re

en désespoir de cause, as tu essayer de redémarrer?

@+