Problème dans une boucle avec un selected ?

Question

Voil&#224; j'ai cr&#233;&#233; un code qui me permet de copier dans un repertoire les photos selectionn&#233; dans une ListeBox. 
Ce code commence par comparer les &#233;l&#233;ments selectionn&#233;s dans ma  ListeBox source (File1)  avec ceux d'une autre ListeBox (File2) visant le repertoire destinations de mes photos, puis demande a changer de nom si il y a des doublons puis fait une copie du fichier si il y n'y a pas de boublons.

Le probl&#232;me est que lorsque je selectionne plusieurs photos  (propri&#233;t&#233; multi select activ&#233;), le test :  If File1.Selected(i) = True  fonctionne mal.

En fait lorsque qu'il passe sur le 1er &#233;l&#233;ment s&#233;lectionn&#233; (disons i=5) tous ce passe bien, il continu le code est fait la copie, mais quand il arrive au 2&#232;me &#233;l&#233;ment selectionn&#233; (disons i=8) il plante.

Je m'arrache les cheveux sur ce code depuis des heures, il va bient&#244;t plus beaucoup m'en rester. 

Voila mon code :

Private Sub cmd_ajout_Click()


    Dim chemin_fichier As String
    Dim i, f As Integer
    Dim new_nom As String    
    
    File2.Refresh
    
    For i = 0 To File1.ListCount - 1
    
        If File1.Selected(i) = True Then       'Test si l'&#233;lement i est s&#233;lectionn&#233;
        
            chemin_fichier = Dir1.Path & "" & File1.List(i)
            new_nom = File1.List(i)
choix:
            For f = 0 To File2.ListCount - 1


                If File2.List(f) = new_nom Then           'on test  si ce nom existe deja
                    new_nom = InputBox("Attention le fichier " & "'" & new_nom & "'" & " correspond a une photo d&#233;j&#224; pr&#233;sente dans ce th&#232;me  !" & vbNewLine & "Veuillez entrer un nouveau nom :", "Choix du nom de la photo")
                    new_nom = new_nom & ".jpg"
                    GoTo choix    'on repare en choix pour tester si le nouveau nom existe
                End If
            
            Next f
            
            'on copie le fichier
            FileCopy chemin_fichier, App.Path & "\multimedia\images" & patient & "" & theme & "" & new_nom
            File1.Refresh
            
        End If
        
    Next i    
    
End Sub

J'esp&#232;re que vous aurez une id&#233;e.
Merci d'avance.

cs_Jack · Answer

Salut
2 probl&#232;mes :
-1- Les DirListBox se refraichissent seules, donc, si tu ajoutes un fichier dans ton r&#233;pertoire et qu'une de tes DirListBox pointe dessus, le nombre de fichiers va changer.
Dans une boucle For-Next, la limite (To File2.ListCount - 1) n'est pas recalcul&#233;e &#224; chaque cycle.
Donc, il se peut que tu pointe vers un fichier qui n'y est plus ou que tu en oublie.
Utilise plut&#244;t un  Do-Loop avec un compteur

-2- Tu ressors de ta 2&#232;me boucle For-Next avec un Goto
Comme VB6 est b&#234;te, il va bien s&#251;r recommencer une nouvelle boucle, mais il va empiler les boucles. D'une part, il y a risque de saturation de la pile du processeur, et d'autre part, &#231;a va perturber ta prog.
L&#224; aussi, vaudrait mieux utiliser une boucle Do-Loop avec un compteur

Pour sortir d'une boucle For-Next, utilise 'Exit For' (idem pour Do-Loop avec 'Exit Do')
Je te propose cette modif pour la 2eme boucle :
            Dim Memo As Boolean
choix:
            Memo = False
            For f = 0 To File2.ListCount - 1


                If File2.List(f) = new_nom Then           'on test  si ce nom existe deja
                    new_nom = InputBox("Attention le fichier " &amp; "'" &amp; new_nom &amp; "'" &amp; " correspond a une photo d&#233;j&#224; pr&#233;sente dans ce th&#232;me  !" &amp; vbNewLine &amp; "Veuillez entrer un nouveau nom :", "Choix du nom de la photo")
                    new_nom = new_nom &amp; ".jpg"
                    Memo = True ' m&#233;morise qu'on a besoin de recommencer
                    Exit For
                End If
            
            Next f
            If Memo Then GoTo choix

Vala
Jack
NB : Je ne r&#233;pondrai pas aux messages priv&#233;s 

Le savoir est la seule mati&#232;re qui s'accroit quand on la partage. (Socrate)

olivier857 · Answer

Merci jack je vais regarder ca !

Juste pour pr&#233;cis&#233; je me suis mal exprim&#233; quand j'arrive sur mon 2&#232;me &#233;l&#233;ment s&#233;lectionn&#233; le :        "  If File1.Selected(i) = True   "    plante pas,  mais renvoie une valeur false, donc l'&#233;l&#233;ments n'est pas d&#233;tecter ce qui explique que je n'arrive pas a copier plusieurs photos.

olivier857 · Answer

Donc si j'ai bien compris tu veux que j'utilise le code :

[code]
Dim Memo As Boolean
    
File2.Refresh
    
For i = 0 To File1.ListCount - 1
    
    If File1.Selected(i) = True Then
        
        chemin_fichier = Dir1.Path & "" & File1.List(i)
        new_nom = File1.List(i)
            
choix:
        Memo = False
        For f = 0 To File2.ListCount - 1
            
            If File2.List(f) = new_nom Then     'on test  si ce nom existe deja
                new_nom = InputBox("Attention le fichier " & "'" & new_nom & "'" & " correspond a une photo d&#233;j&#224; pr&#233;sente dans ce th&#232;me  !" & vbNewLine & "Veuillez entrer un nouveau nom :", "Choix du nom de la photo")
                new_nom = new_nom & ".jpg"
                Memo = True ' m&#233;morise qu'on a besoin de recommencer
                Exit For
            End If
                        
        Next f
        If Memo Then GoTo choix
        
        FileCopy chemin_fichier, App.Path & "\multimedia\images" & patient & "" & theme & "" & new_nom
        File1.Refresh
        
    End If
    
Next i
[\code]

Si c'est bien cela, c'est fait j'ai tester, mais malheureusement le r&#233;sultat est le m&#234;me. 

Mais je ne pense pas que mon probl&#232;me viene de l&#224;.
C'est apparement vraiment sur la propri&#233;t&#233; selected qui beugue il ne la detecte qu'une seul fois a true, j'ai mis des points d'arret pour verifier cela.

Olivier !

valtrase · Answer

Salut,
dis moi pourquoi un File1.Refresh apr&#233;s ton copy &#231;a ne veindrai pas de l&#224; par hazard ?
Private Sub cmd_ajout_Click()
    Dim chemin_fichier As String
    Dim i, f As Integer
    Dim new_nom As String    
    
    File2.Refresh
    
    For i = 0 To File1.ListCount - 1
    
        If File1.Selected(i) = True Then       'Test si l'&#233;lement i est s&#233;lectionn&#233;
        
            chemin_fichier = Dir1.Path & "" & File1.List(i)
            new_nom = File1.List(i)
choix:
            For f = 0 To File2.ListCount - 1


                If File2.List(f) = new_nom Then           'on test  si ce nom existe deja
                    new_nom = InputBox("Attention le fichier " & "'" & new_nom & "'" & " correspond a une photo d&#233;j&#224; pr&#233;sente dans ce th&#232;me  !" & vbNewLine & "Veuillez entrer un nouveau nom :", "Choix du nom de la photo")
                    new_nom = new_nom & ".jpg"
                    GoTo choix    'on repare en choix pour tester si le nouveau nom existe
                End If
            
            Next f
            
            'on copie le fichier
            FileCopy chemin_fichier, App.Path & "\multimedia\images" & patient & "" & theme & "" & new_nom
            File1.Refresh
            
        End If
        
    Next i    
    
End Sub

____________________________________________________

Cordialement, Jean-Paul

Le Savoir n'a de valeur que s'il est partag&#233;

olivier857 · Answer

Et bien honetement je ne sais pas, je ne sais plus pourquoi je l'ai mis, il y avait peut etre raison mais bon....

En tout cas bien vu, car ca venait bien de l&#224;.

Merci beaucoup ! j'aurais pu chercher lgt.

olivier

Problème dans une boucle avec un selected ?

5 réponses

Discussions similaires