Boucle For, qui boucle sans cesse :(

F

Fariri

XLDnaute Junior
Bonjour,

Je reviens vers vous car une fois de plus, j'ai un soucis que je n'arrive pas à résoudre, j'ai essayé plusieurs solution mais en vain (depuis 13H00, je suis dessus :confused:)

Dans ma procédure, le code ci-dessous ne n'arrête jamais, le "For" ne s'arrête jamais. o_O
de plus ma multipage ne s'ouvre pas à la page 3,
(j'ai mis en couleur rouge, les soucis)

VB: 
Private Sub CommandButton2_Click()  => BOUTON

Dim V_Boite 'variable pour la message Box qui apparaît




   'Si la TEXTBOX001 est vide la messageBox apparait

    If TextBox001.Value = "" Then

    MsgBox ("Veuillez sélectionner un agent")

'

    'Si la TEXTBOX3  est vide la messageBox apparait

    ElseIf TextBox3.Value = "" Then

    MsgBox ("Veuillez sélectionner un véhicule")




     'Si la TEXTBOX3  est différente de vide, alors

      Else




              'CHERCHE LES VALEUR DE LA TEXTBOX001  ET DE LA TEXTBOX3 SUR LA MEME LIGNE

              'Activation de la feuille Véhicule_Agent

               Worksheets("Véhicule_Agent").Select

      

               'Permet de trouver le nombre de ligne à partir de la colonne 1

                Cells(2, 1).Select 'ligne 2, colonne 1

                Ligne = Range(Selection, Selection.End(xlDown)).Rows.Count + 1  'Met dans la variable Ligne la sélection sélectionnée

                    

                'Cherche dans le tableau dans la colonne 1 et 4 la valeur de TextBox002  et de la TextBox6

                For i = 2 To Ligne

                If Cells(i, 1).Value & Cells(i, 4).Value = TextBox001.Value & TextBox3.Value Then

                            'Je fais apparaître une fenêtre avec un message et un bouton OK

                             MsgBox "Le véhicule immatriculé " & TextBox3.Text & " est déja attribué à l'agent " & TextBox2.Text & " " & TextBox1.Text & " ", vbOKOnly + vbInformation

  

'

                            'APPARITION DE LA MESSAGE BOX

                             Else: V_Boite = MsgBox("Voulez-vous attribuer un véhicule à : " & TextBox2.Text & " " & TextBox1.Text & " ?", vbYesNo + vbQuestion, "question")

                      

                                     'Sinon si clique sur "oui"

                                     If V_Boite = vbYes Then

                            '

                            '

                                    'Je rentre les données dans la feuille Véhicule_Agent

                                                                '

                                        Sheets("Véhicule_Agent").Range("A1").End(xlDown).Offset(1, 0).Value = TextBox001.Value

                                        Sheets("Véhicule_Agent").Range("B1").End(xlDown).Offset(1, 0).Value = TextBox1.Value

                                        Sheets("Véhicule_Agent").Range("C1").End(xlDown).Offset(1, 0).Value = TextBox2.Value

                                        Sheets("Véhicule_Agent").Range("D1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex)

                                        Sheets("Véhicule_Agent").Range("E1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 1)

                                        Sheets("Véhicule_Agent").Range("F1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 2)

                                        Sheets("Véhicule_Agent").Range("G1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 3)

                                        Sheets("Véhicule_Agent").Range("H1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 4)

                                        Sheets("Véhicule_Agent").Range("I1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 5)

                            '

                                        'Je fais apparaître une fenêtre avec un message et un bouton OK

                                         MsgBox "Le véhicule immatriculé " & TextBox3.Text & " a été attribué à l'agent " & TextBox2.Text & "  " & TextBox1.Text & " ", vbOKOnly + vbInformation

                            '

                                                       'Rafraichir l'userfom (il se ferme puis s'ouvre)

                                                        Unload Me

                                                        UserVehiculeAffectation.Show

                                                        MultiPage1.Value = 2 'Activation de l'onglet 3

                            '

                            'Ecriture de la date du jour dans la ComboBox102

                            Sheets("ACCES FICHE").TextBox102 = Date

                            '

                                             'Sinon si clique sur "non"

                                             Else

                                             MsgBox ("La base de données n'a pas été modifié")

                                        

                                                     End If

                                     End If

                                

                                    Next i                                         

                            '

                                      

                            End If

                            '

End sub

Merci pour votre aide
Pour des raisons de confidentialité, je ne peux pas poster le fichier (de plus si je le modifie pour le poster, au vue de sa taille je risque de le planter) -----> désolé
 
Dernière édition:
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re,

Lorsque l'on met du code sur le forum, il faut aller en mode avancé si tu n'y es pas automatiquement
Et tu cliques sur le bouton
2019-04-13_18h25_58.png

Dans la fenêtre tu colles le code que tu as préalablement coupé

Merci pour nos yeux
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir Fariri, BrunoM45

Fariri à dit:
Pour des raisons de confidentialité, je ne peux pas poster le fichier (de plus si je le modifie pour le poster, au vue de sa taille je risque de le planter)
Cliquez pour agrandir...
:eek:
Il suffit de faire une copie du fichier
Et sur cette copie, opérer tout ce qu'on veut (on s'en fout c'est une copie!)
Donc tu peux anonymiser, ratiboiser etc puis zipper la copie et enfin la joindre ici
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re,

Il vaut mieux éviter de faire des If... End If qui n'en finissent pas ou juste à la fin de la procédure, c'est imbuvable

Voici sans fichier à tester
VB: 
Private Sub CommandButton2_Click()
  Dim DLig As Long, Lig As Long
  Dim Sht As Worksheet
  'Si la TEXTBOX001 est vide la messageBox apparait
  If Me.TextBox001.Value = "" Then
    MsgBox ("Veuillez sélectionner un agent")
    Exit Sub
  End If
  'Si la TEXTBOX3 est vide la messageBox apparait
  If Me.TextBox3.Value = "" Then
    MsgBox ("Veuillez sélectionner un véhicule")
    Exit Sub
  End If
  'CHERCHE LES VALEUR DE LA TEXTBOX001 ET DE LA TEXTBOX3 SUR LA MEME LIGNE
  ' Définir la feuille de travail
  Set Sht = Worksheets("Véhicule_Agent")
  ' Permet de trouver la dernière ligne complétée
  DLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  'Cherche dans le tableau dans la colonne 1 et 4 la valeur de TextBox002 et de la TextBox6
  For Lig = 2 To DLig
    If Sht.Cells(Lig, 1).Value & Sht.Cells(Lig, 4).Value = TextBox001.Value & TextBox3.Value Then
      'Je fais apparaître une fenêtre avec un message et un bouton OK
      MsgBox "Le véhicule immatriculé " & TextBox3.Text & " est déja attribué à l'agent " & TextBox2.Text & " " & TextBox1.Text & " ", vbOKOnly + vbInformation
      ' On sort
      Exit Sub
    End If
  Next Lig
  '
  ' APPARITION DE LA MESSAGE BOX
  If MsgBox("Voulez-vous attribuer un véhicule à : " & TextBox2.Text & " " & TextBox1.Text & " ?", _
    vbYesNo + vbQuestion, "question") = vbYes Then
    '
    ' Je rentre les données dans la feuille Véhicule_Agent
    Sht.Range("A1").End(xlDown).Offset(1, 0).Value = TextBox001.Value
    Sht.Range("B1").End(xlDown).Offset(1, 0).Value = TextBox1.Value
    Sht.Range("C1").End(xlDown).Offset(1, 0).Value = TextBox2.Value
    Sht.Range("D1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex)
    Sht.Range("E1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 1)
    Sht.Range("F1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 2)
    Sht.Range("G1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 3)
    Sht.Range("H1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 4)
    Sht.Range("I1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 5)
    '
    'Je fais apparaître une fenêtre avec un message et un bouton OK
    MsgBox "Le véhicule immatriculé " & TextBox3.Text & " a été attribué à l'agent " & TextBox2.Text & " " & TextBox1.Text & " ", vbOKOnly + vbInformation
    '
    ' Rafraichir l'userfom (il se ferme puis s'ouvre)
    ' TRES MAUVAISE METHODE
    'Unload Me
    'UserVehiculeAffectation.Show
    ' Mieux vaut utiliser
    Call UserForm.Initialize
    MultiPage1.Value = 2 'Activation de l'onglet 3
    '
    'Ecriture de la date du jour dans la ComboBox102
    Sheets("ACCES FICHE").TextBox102 = Date
    '
    'Sinon si clique sur "non"
  Else
    MsgBox ("La base de données n'a pas été modifié")
  End If
  ' Effacer la variable objet
  Set Sht = Nothing
End Sub

A+
 
Vote positif 0 Vote négatif
F

Fariri

XLDnaute Junior
BrunoM45 à dit:
Re,

Il vaut mieux éviter de faire des If... End If qui n'en finissent pas ou juste à la fin de la procédure, c'est imbuvable

Voici sans fichier à tester
VB: 
Private Sub CommandButton2_Click()
  Dim DLig As Long, Lig As Long
  Dim Sht As Worksheet
  'Si la TEXTBOX001 est vide la messageBox apparait
  If Me.TextBox001.Value = "" Then
    MsgBox ("Veuillez sélectionner un agent")
    Exit Sub
  End If
  'Si la TEXTBOX3 est vide la messageBox apparait
  If Me.TextBox3.Value = "" Then
    MsgBox ("Veuillez sélectionner un véhicule")
    Exit Sub
  End If
  'CHERCHE LES VALEUR DE LA TEXTBOX001 ET DE LA TEXTBOX3 SUR LA MEME LIGNE
  ' Définir la feuille de travail
  Set Sht = Worksheets("Véhicule_Agent")
  ' Permet de trouver la dernière ligne complétée
  DLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  'Cherche dans le tableau dans la colonne 1 et 4 la valeur de TextBox002 et de la TextBox6
  For Lig = 2 To DLig
    If Sht.Cells(Lig, 1).Value & Sht.Cells(Lig, 4).Value = TextBox001.Value & TextBox3.Value Then
      'Je fais apparaître une fenêtre avec un message et un bouton OK
      MsgBox "Le véhicule immatriculé " & TextBox3.Text & " est déja attribué à l'agent " & TextBox2.Text & " " & TextBox1.Text & " ", vbOKOnly + vbInformation
      ' On sort
      Exit Sub
    End If
  Next Lig
  '
  ' APPARITION DE LA MESSAGE BOX
  If MsgBox("Voulez-vous attribuer un véhicule à : " & TextBox2.Text & " " & TextBox1.Text & " ?", _
    vbYesNo + vbQuestion, "question") = vbYes Then
    '
    ' Je rentre les données dans la feuille Véhicule_Agent
    Sht.Range("A1").End(xlDown).Offset(1, 0).Value = TextBox001.Value
    Sht.Range("B1").End(xlDown).Offset(1, 0).Value = TextBox1.Value
    Sht.Range("C1").End(xlDown).Offset(1, 0).Value = TextBox2.Value
    Sht.Range("D1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex)
    Sht.Range("E1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 1)
    Sht.Range("F1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 2)
    Sht.Range("G1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 3)
    Sht.Range("H1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 4)
    Sht.Range("I1").End(xlDown).Offset(1, 0).Value = ListBox2.List(ListBox2.ListIndex, 5)
    '
    'Je fais apparaître une fenêtre avec un message et un bouton OK
    MsgBox "Le véhicule immatriculé " & TextBox3.Text & " a été attribué à l'agent " & TextBox2.Text & " " & TextBox1.Text & " ", vbOKOnly + vbInformation
    '
    ' Rafraichir l'userfom (il se ferme puis s'ouvre)
    ' TRES MAUVAISE METHODE
    'Unload Me
    'UserVehiculeAffectation.Show
    ' Mieux vaut utiliser
    Call UserForm.Initialize
    MultiPage1.Value = 2 'Activation de l'onglet 3
    '
    'Ecriture de la date du jour dans la ComboBox102
    Sheets("ACCES FICHE").TextBox102 = Date
    '
    'Sinon si clique sur "non"
  Else
    MsgBox ("La base de données n'a pas été modifié")
  End If
  ' Effacer la variable objet
  Set Sht = Nothing
End Sub

A+
Cliquez pour agrandir...
Je te remercie beaucoup d'avoir pris le temps de corriger mon code, super il fonctionne super bien
hormis une chose le :

Call UserForm.Initialize -> Ne fonctionne pas : Erreur d'exécution '424' - Objet requis

Je suis sur Excel Pro Plus 2013

De part le passé, j'ai essayé plusieurs méthode pour réinitialisé mon Userform mais à chaque fois sans succès (je ne comprends pas pourquoi)

Si tu as une autre solution, je suis preneuse ;)
merci
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
886
thivame
T
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
403
Mody200
M
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
163
Francky79
F
E
  • Question
XL 2013 vba excel
Réponses
6
Affichages
227
sylvanu
sylvanu
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
213
Zonmé
Z
pompaero
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
191
pompaero
pompaero
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
223
florian50470
F
C
  • Résolu(e)
XL 2021 Tri alpha sur combobox à 2 colonnes
2
Réponses
15
Affichages
341
dysorthographie
dysorthographie
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
59
Latias
L
F
  • Résolu(e)
Microsoft 365 Commentaire cellule dans TextBox dans UserForm
Réponses
4
Affichages
369
Francky79
F

Membres actuellement en ligne

27 membres et 313 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 090
Messages
2 085 210
Membres
102 820
dernier inscrit
SIEG68