Formulaire de validation et saisi.Résolu

Question

Bonjour à toutes et tous, Je suis en train de concevoir un petit logiciel VBA de gestion d'inventaire et j'aimerais savoir si c'est possible de récupérer le clique d'un bouton pour que la boucle continue. En gros, mon logiciel liera à partir d'une feuille appeler Inventaire les informations concernant un matériel X et enregistrera l'état de ce matériel, son emplacement et qui l'utilisera. Le code qui fait cela est celui-ci: 'S'il y a plus de 3 éléments dans la feuille on y va. If NbLignesRech > 3 Then Application.StatusBar = "Macro en cours d’exécution, veuillez patienter" Application.ScreenUpdating = False For Each Elem In Rech.Range("4:" & NbLignesRech).Rows DoEvents Set Trouve = PlageDeRecherche.Cells.Find(what:=Elem.Cells(1, 4).Value, LookAt:=xlWhole) 'Traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'Ici, traitement pour le cas où la valeur n'est pas trouvée PasTrouver = PasTrouver + 1 FPasTrouve.Rows(PasTrouver).Cells(1, 1) = Elem.Cells(1, 4).Value 'Exit Function Else ' Ici si l'élément est trouvé. 'VarGlobal = Bd.Cells(Trouve.Row, 6).Value 'Ajout des informations dans les textBox. UFSorties2.TBXPCCC.Text = Bd.Cells(Trouve.Row, 3).Value UFSorties2.TBXCodeBarre.Text = Bd.Cells(Trouve.Row, 4).Value UFSorties2.TBXNDP.Text = Bd.Cells(Trouve.Row, 6).Value UFSorties2.TBXItem.Text = Bd.Cells(Trouve.Row, 7).Value ' Sélection de l'état du bien UFSorties2.CBXEtat.AddItem "Déployé" UFSorties2.CBXEtat.AddItem "En cours d'assemblage" UFSorties2.CBXEtat.AddItem "En inventaire" UFSorties2.CBXEtat.AddItem "Transféré" ' Selection du rôle du bien. UFSorties2.CBXRole.AddItem "Poste principal" UFSorties2.CBXRole.AddItem "Poste vacant" UFSorties2.CBXRole.AddItem "Poste partagé" UFSorties2.CBXRole.AddItem "Poste dédié" UFSorties2.CBXRole.AddItem "Poste formation" UFSorties2.CBXRole.AddItem "Poste essai" UFSorties2.CBXRole.AddItem "Poste dépannage" UFSorties2.CBXRole.AddItem "Poste complémentaire" ' Sélection du système d'exploitation. UFSorties2.CbxSysExp.AddItem "Windows 7" UFSorties2.CbxSysExp.AddItem "Windows 8.1" UFSorties2.CbxSysExp.AddItem "Windows 10" ' Affichage de la forme. UFSorties2.Show NbLigneEntrees = NbLigneEntrees + 1 End If Next End If If NbLignesRech < 4 Then MsgBox " Aucune occurence à chercher. Ajoutez des éléments dans l'onglet Recherche s.v.p.! " End If Application.ScreenUpdating = True Entrees.Columns.AutoFit If PasTrouver <> 0 Then MsgBox "Terminé. Nb élement(s) non trouvé(s): " & PasTrouver Else: MsgBox "Recherche Terminé. " End If Dans la forme UFSorties2, j'ai un bouton Ok lorsque terminé: Private Sub CmdOk_Click() Exit Sub End Sub EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique). Explications disponibles ici :ICI Merci d'y penser dans tes prochains messages. Jordane45 Et c'est la que ça coince car mon programme ne reviens pas dans la boucle pour aller à l'élément suivant... Espérant mes explications assez clairs, est-ce que quelqu'un aurait une idée? --

jordane45 · Answer

Bonjour,

Il faudrait le début de ton code.... là on ne sait pas si c'est dans une sub, une fonction ...
On ne sait même pas comment sont initialisées tes différentes variables...
 

NB : Le  Exit Sub s'applique à la SUB où il se trouve... à rien d'autre !

Jlpic · Answer

Bonjour jordane45, Merci de ta réponse. Désolé, je ne croyais pas nécessaire de mettre tout le code puisque mon problème viens du bouton. Le voici donc: Option Explicit Private Sub CmdOk_Click() Exit Sub End Sub Private Sub UserForm_Initialize() With Me .startUpPosition = 2 .Left = Application.Width - Me.Width End With Dim Rech As Worksheet Dim Entrees As Worksheet Dim Sortie As Worksheet Dim FPasTrouve As Worksheet Dim Bd As Worksheet Dim WSR34Q32 As Worksheet Dim WSConsommable As Worksheet Dim NbLigneEntrees As Integer Dim Test As String Dim Bidon As Integer Dim LigneH As Long Dim Count As Long Dim NbLignesRech As Long Dim NbLigneBd As Long Dim Lauck As Integer Dim Parcours As Integer Dim Mouve As String Dim PasTrouver As Integer Dim VerifSiOccur As Long Dim Elem As Variant Dim Trouve As Range Dim PlageDeRecherche As Range Dim LongChaine As Integer Dim Clique As Integer Set Entrees = Worksheets("Résultat recherche") Set Bd = Worksheets("GParc") Set Rech = Worksheets("ProgPrincipal") Set FPasTrouve = Worksheets("ListePasTrouve") Set WSR34Q32 = Worksheets("Inventaire") Set WSConsommable = Worksheets("Consommable") Set PlageDeRecherche = Bd.Columns(4) LigneH = Entrees.Range("A65536").End(xlUp).Row + 1 NbLigneBd = Bd.Range("A" & Rows.Count).End(xlUp).Row NbLignesRech = Rech.Range("D" & Rows.Count).End(xlUp).Row Parcours = 1 PasTrouver = 0 FPasTrouve.Cells.Clear Entrees.Cells.Clear Bd.Activate Cells(1).EntireRow.Copy Entrees.Activate Cells(1).PasteSpecial NbLigneEntrees = 1 If NbLignesRech > 3 Then Application.StatusBar = "Macro en cours d’exécution, veuillez patienter" Application.ScreenUpdating = False For Each Elem In Rech.Range("4:" & NbLignesRech).Rows DoEvents Set Trouve = PlageDeRecherche.Cells.Find(what:=Elem.Cells(1, 4).Value, LookAt:=xlWhole) 'Traitement de l'erreur possible : Si on ne trouve rien : If Trouve Is Nothing Then 'Ici, traitement pour le cas où la valeur n'est pas trouvée PasTrouver = PasTrouver + 1 FPasTrouve.Rows(PasTrouver).Cells(1, 1) = Elem.Cells(1, 4).Value 'Exit Function Else ' Ici si l'élément est trouvé. 'VarGlobal = Bd.Cells(Trouve.Row, 6).Value 'Affichage des informations dans les textBox. UFSorties2.TBXPCCC.Text = Bd.Cells(Trouve.Row, 3).Value UFSorties2.TBXCodeBarre.Text = Bd.Cells(Trouve.Row, 4).Value UFSorties2.TBXNDP.Text = Bd.Cells(Trouve.Row, 6).Value UFSorties2.TBXItem.Text = Bd.Cells(Trouve.Row, 7).Value ' Sélection de l'état du bien UFSorties2.CBXEtat.AddItem "Déployé" UFSorties2.CBXEtat.AddItem "En cours d'assemblage" UFSorties2.CBXEtat.AddItem "En inventaire" UFSorties2.CBXEtat.AddItem "Transféré" ' Selection du rôle du bien. UFSorties2.CBXRole.AddItem "Poste principal" UFSorties2.CBXRole.AddItem "Poste vacant" UFSorties2.CBXRole.AddItem "Poste partagé" UFSorties2.CBXRole.AddItem "Poste dédié" UFSorties2.CBXRole.AddItem "Poste formation" UFSorties2.CBXRole.AddItem "Poste essai" UFSorties2.CBXRole.AddItem "Poste dépannage" UFSorties2.CBXRole.AddItem "Poste complémentaire" ' Sélection du système d'exploitation. UFSorties2.CbxSysExp.AddItem "Windows 7" UFSorties2.CbxSysExp.AddItem "Windows 8.1" UFSorties2.CbxSysExp.AddItem "Windows 10" ' Affichage de la forme. UFSorties2.Show NbLigneEntrees = NbLigneEntrees + 1 End If Next End If If NbLignesRech < 4 Then MsgBox " Aucune occurence à chercher. Ajoutez des éléments dans l'onglet Recherche s.v.p.! " End If Application.ScreenUpdating = True Entrees.Columns.AutoFit If PasTrouver <> 0 Then MsgBox "Terminé. Nb élement(s) non trouvé(s): " & PasTrouver Else: MsgBox "Recherche Terminé. " End If 'vidage des variables Set PlageDeRecherche = Nothing Set Trouve = Nothing End Sub Il faut dire que ce programme est un test que je vais épurer lorsque je saurais s'il est possible de faire ce que je veux faire. De plus, J'ai essayé avec inputbox et msgbox mais cela ne donne vrm pas ce que je veux. Il faudrait en bref trouver un moyen de revenir à la boucle lorsque le bouton "ok" est appuyer. Prendre note qu'évidemment je ne suis pas un programmeur de longue date donc sois indulgent !;¬) Un gros merci de ton aide!!! --

cs_MPi · Answer

Bonjour,

Si tu veux pouvoir utiliser le bouton pendant que ton code roule, il faudrait mettre DoEvents à l'intérieur de ta boucle pour donner la main au système. À voir dans l'aide au besoin.

Jlpic · Answer

Bonjour cs_MPI,

  Il y en a un juste après le for each qui est la boucle... 
 
Je suis capable de modifier mon formulaire c'est vraiment le bouton le problème qui ne reviens pas dans la boucle après le clique. Il va dans le sub:

Private Sub CmdOk_Click() 
 Exit Sub 
End Sub 

et ne reviens pas dans la boucle.

Merci de ton aide.

--

cs_MPi · Answer

Désolé... je ne l'avais pas vu.
Du coup, je ne comprends pas vraiment ce que tu cherches à faire.
Je pensais que tu voulais quitter la boucle, ce que fait le bouton avec Exit Sub.

Le code dans Initialize affiche un 2e userform, c'est ça ?
Et tu veux revenir dans ce bout de code du premier userform ?

Si c'est ça, il te faut fermer le 1er userform pour pouvoir revenir dans le Initialize, autrement, tu ne pourras pas y revenir puisque déjà "loadé". 

Et n'oublie pas de formater ton code à l'aide du bouton <> pour le rendre plus lisible...

Jlpic · Answer

Bonjour cs_MPI,

  Je vais essayer d'être plus explicite:

Je copie dans un classeur des codes barres d'équipements qui sort de notre local (il y en a beaucoup dans une journée!). Dans ce même classeur, j'ai un bouton qui lance le programme une fois les codes barres copiés:

Sub Sorties_Cliquer()
   
   UFSorties2.Show

End Sub

le reste du code s'exécute par la suite. Dans ce dernier, je vérifie si c'est le bon équipement en affichant l'info dans des zone texte non modifiable et ajoute quelques informations comme l'emplacement, son état, ect...avec des zones texte modifiable ainsi que des listes déroulantes.

La boucle sert à parcourir tout les codes barres de la feuille et le bouton "Ok" a faire continuer la boucle une fois les informations validées et modifier.

L'enregistrement des information n'est pas incluse présentement dans le code car je ne suis pas rendu là, la boucle ne faisant pas la job que je veux pour l'instant.   
 
J'espère que ce sera plus clair maintenant. N'hésites pas à me faire part des tes interrogations ou commentaires. Il existe peut être un meilleur moyen de parvenir à mes fins.

J'ai pris note de ton commentaire pour les <>. Désolé, je n'avais pas remarqué qu'il fallait faire cela, j'y porterais attention la prochaine fois...


@jordan45: Est-ce que je peux remplacer "exit sub" par autre chose afin de retourner dans la boucle? Ou sinon, récupérer le clique sur le bouton d'une façon quelqu'onque afin que la boucle continue? 

Je vous remercie de votre temps, c'est apprécié!


--

cs_MPi · Answer

Plutôt que de mettre ton code dans Initialize, tu pourrais utiliser un bouton. 

Et plutôt que d'y aller avec 
For Each Elem In Rech.Range("4:" & NbLignesRech).Rows 
tu pourrais utiliser une variable compteur Static qui conserve sa valeur... (voir l'aide)

Donc, à chaque click sur le bouton tu augmentes la valeur du compteur de 1 et tu fais ton traitement sans boucle.

Jlpic · Answer

Bonjour cs_MPI,

  Merci de ta réponse. En fait, j'avais commencé par cela au début mais j'avais un autre problème dont je ne me souviens plus. J'ai tellement fais d'essais...

  Bref, si je comprends bien, il est impossible de récupérer un clic de bouton pour faire continuer une boucle. Je vais devoir retourner encore une fois sur la planche à dessin!;¬).

Je ne fermerais pas la discussion tout de suite des fois qu'on aurait une autre idée.

Gros merci de ton aide!

Jlpic · Answer

Eureka!!!

J'ai trouvé une façon de faire fonctionné mon programme!

Premièrement, j'ai remplacé le bouton "OK" par une case à cochée "ok". Ensuite, j'ai fais l'affichage de la form en mode non modal. J'ai ajouté un do loop avec doevents et la condition de rester dans la boucle tant et aussi longtemps que la case à cochée est à "False". Ainsi, j'affiche les informations des équipements et modifie les autres champs sans problème. Le programme passe au prochain équipement lorsque je clique sur la cas à cochée! Voici le code pour ceux ou celles qui ça intéresse.

If NbLignesRech > 3 Then
     Application.StatusBar = "Macro en cours d’exécution, veuillez patienter"
     Application.ScreenUpdating = False
     For Each Elem In Rech.Range("4:" & NbLignesRech).Rows
         DoEvents
         Bidon = 0
         ChkOk.Value = False
         Set Trouve = PlageDeRecherche.Cells.Find(what:=Elem.Cells(1, 4).Value, LookAt:=xlWhole)
         'Traitement de l'erreur possible : Si on ne trouve rien :
         If Trouve Is Nothing Then
             ChkOk.Value = False
             'Ici, traitement pour le cas où la valeur n'est pas trouvée
             PasTrouver = PasTrouver + 1
             FPasTrouve.Rows(PasTrouver).Cells(1, 1) = Elem.Cells(1, 4).Value
             'Exit Function
             Else
             ' Ici si l'élément est trouvé.
             'VarGlobal = Bd.Cells(Trouve.Row, 6).Value
            
             'Affichage des informations dans les textBox.
            
             TBXPCCC.Text = Bd.Cells(Trouve.Row, 3).Value
             UFSorties2.TBXCodeBarre.Text = Bd.Cells(Trouve.Row, 4).Value
             UFSorties2.TBXNDP.Text = Bd.Cells(Trouve.Row, 6).Value
             UFSorties2.TBXItem.Text = Bd.Cells(Trouve.Row, 7).Value
            
             ' Sélection de l'état du bien
            
             UFSorties2.CBXEtat.AddItem "Déployé"
             UFSorties2.CBXEtat.AddItem "En cours d'assemblage"
             UFSorties2.CBXEtat.AddItem "En inventaire"
             UFSorties2.CBXEtat.AddItem "Transféré"
            
             ' Selection du rôle du bien.
            
             UFSorties2.CBXRole.AddItem "Poste principal"
             UFSorties2.CBXRole.AddItem "Poste vacant"
             UFSorties2.CBXRole.AddItem "Poste partagé"
             UFSorties2.CBXRole.AddItem "Poste dédié"
             UFSorties2.CBXRole.AddItem "Poste formation"
             UFSorties2.CBXRole.AddItem "Poste essai"
             UFSorties2.CBXRole.AddItem "Poste dépannage"
             UFSorties2.CBXRole.AddItem "Poste complémentaire"
            
             ' Sélection du système d'exploitation.
            
               UFSorties2.CbxSysExp.AddItem "Windows 7"
               UFSorties2.CbxSysExp.AddItem "Windows 8.1"
               UFSorties2.CbxSysExp.AddItem "Windows 10"

' Affichage de la forme en mode modal.
               UFSorties2.Show 0
             
             ' Tant que la case à coché est à false, je boucle.

Do
             
                DoEvents
                If ChkOk.Value = True Then
                  Bidon = 1
                End If
             Loop Until Bidon <> 0
             
             NbLigneEntrees = NbLigneEntrees + 1
        
         End If
     Next
 End If

Je sais que ce n'est pas jolie jolie comme programmation mais ça marche!!!


Merci de votre aide...

Au plaisir!

--

Formulaire de validation et saisi.

Explications disponibles ici :ICI

9 réponses

Votre réponse

Discussions similaires