Formulaire de validation et saisi. [Résolu]

Jlpic 8 Messages postés jeudi 20 mai 2004Date d'inscription 10 novembre 2017 Dernière intervention - 3 nov. 2017 à 18:01 - Dernière réponse : Jlpic 8 Messages postés jeudi 20 mai 2004Date d'inscription 10 novembre 2017 Dernière intervention
- 10 nov. 2017 à 14:38
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?
--
Afficher la suite 

Votre réponse

9 réponses

jordane45 22546 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 22 septembre 2018 Dernière intervention - 5 nov. 2017 à 00:46
0
Merci
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 !

Commenter la réponse de jordane45
Jlpic 8 Messages postés jeudi 20 mai 2004Date d'inscription 10 novembre 2017 Dernière intervention - 6 nov. 2017 à 14:18
0
Merci
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!!!



--
Commenter la réponse de Jlpic
cs_MPi 3877 Messages postés mardi 19 mars 2002Date d'inscription 23 août 2018 Dernière intervention - 6 nov. 2017 à 14:29
0
Merci
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.
Commenter la réponse de cs_MPi
Jlpic 8 Messages postés jeudi 20 mai 2004Date d'inscription 10 novembre 2017 Dernière intervention - Modifié par Jlpic le 6/11/2017 à 15:04
0
Merci
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.

--
Commenter la réponse de Jlpic
cs_MPi 3877 Messages postés mardi 19 mars 2002Date d'inscription 23 août 2018 Dernière intervention - 6 nov. 2017 à 15:20
0
Merci
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...
Commenter la réponse de cs_MPi
Jlpic 8 Messages postés jeudi 20 mai 2004Date d'inscription 10 novembre 2017 Dernière intervention - Modifié par Jlpic le 6/11/2017 à 16:27
0
Merci
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é!


--
Commenter la réponse de Jlpic
cs_MPi 3877 Messages postés mardi 19 mars 2002Date d'inscription 23 août 2018 Dernière intervention - 7 nov. 2017 à 15:15
0
Merci
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.
Commenter la réponse de cs_MPi
Jlpic 8 Messages postés jeudi 20 mai 2004Date d'inscription 10 novembre 2017 Dernière intervention - 7 nov. 2017 à 22:03
0
Merci
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!
Commenter la réponse de Jlpic
Jlpic 8 Messages postés jeudi 20 mai 2004Date d'inscription 10 novembre 2017 Dernière intervention - Modifié par Jlpic le 10/11/2017 à 14:43
0
Merci
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!

--
Commenter la réponse de Jlpic

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.