Vider ListBox

Y compris Power BI, Power Query et toute autre question en lien avec Excel
B
Bandit
Jeune membre
Jeune membre
Messages : 20
Appréciation reçue : 1
Inscrit le : 30 septembre 2018
Version d'Excel : 2003

Message par Bandit » 30 septembre 2018, 09:21

Bonjour A TOUS,

Je suis totalement novice en VBA mais j'ai déjà réussi à faire certains trucs sauf que pour mon projet actuel je tombe sur un os .... :/
Avec le code ci-dessous, je rempli un tableau excel.
En appuyant sur le bouton GENERER, mon tableau excel se rempli et le UserForm se ferme.
Moi j'aimerais que mon tableau se remplisse mais que ma ListBox se régénère sans ferme l'UserForm.

Quelle formule pour se déroulement ?

En vous remerciant par avance.

Bandit
""""""""
Private Sub Bouton_Generer_Click()
Dim nombre_ligne As Integer
Dim ligne As Integer
Dim dl As Integer

If Me.Txt_List.ListCount > 0 And Me.Txt_Client.ListIndex >= 0 Then

'Demander une confirmation de BL
If MsgBox("Voulez-vous validez le BL ?", vbYesNo) = vbYes Then

nombre_ligne = Me.Txt_List.ListCount - 1

For ligne = 0 To nombre_ligne
Sheets(3).ListObjects(1).ListRows.Add
dl = Sheets(3).Range("b9999").End(xlUp).Row

'Afficher nos informations dans la base de donnée BL
Sheets(3).Range("B" & dl) = Me.Txt_Nr_BL.Caption
Sheets(3).Range("C" & dl) = CDate(Now())
Sheets(3).Range("D" & dl) = Me.Txt_List.List(ligne, 0)
Sheets(3).Range("E" & dl) = Me.Txt_List.List(ligne, 1)
Sheets(3).Range("F" & dl) = Me.Txt_List.List(ligne, 2)
Sheets(3).Range("G" & dl) = CInt(Me.Txt_List.List(ligne, 3))
Sheets(3).Range("H" & dl) = CCur(Me.Txt_List.List(ligne, 4))
Sheets(3).Range("I" & dl) = CCur(Me.Txt_List.List(ligne, 5))
Sheets(3).Range("J" & dl) = Me.Txt_Client
Sheets(3).Range("k" & dl) = Me.Txt_Car

Next ligne
Unload Add_BL

End If

Else
MsgBox "Pas de BL Disponnible"

End If

End Sub
""""""""""""""""
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'201
Appréciations reçues : 444
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 30 septembre 2018, 10:11

Bonjour,

D'abord, au lieu de décharger le Userform, tu le masques Me.Hide, de préférence avant de procéder à la validation, et à l'issue tu le réaffiches Me.Show. Il faut que avant ou lors du réaffichage, tu réinitialises les contrôles qui doivent l'être, ce qui peut se faire soit avec une procédure de réinitialisation, appelée avant réaffichage, soit si tu as une Initialize (qui ne s'exécute qu'une fois au chargement), en basculer les éléments qui répondent à la mise en place avant toute nouvelle utilisation sur la procédure Activate (qui s'exécute avant tout affichage du Userform) en la complétant éventuellement...

Pour vider la liste d'une ListBox (ta question ?) la méthode est : .Clear.

Pour ajuster le tout, il faudrait voir le reste de ton code, donc le fichier...

Il y a aussi matière à améliorer ta procédure de validation pour la rendre plus efficace...

Cordialement.
B
Bandit
Jeune membre
Jeune membre
Messages : 20
Appréciation reçue : 1
Inscrit le : 30 septembre 2018
Version d'Excel : 2003

Message par Bandit » 30 septembre 2018, 10:47

Merci MFerrand pour ta réponse rapide,

Effectivement, juste avec ".Clear" ça ne fonctionne pas... :/
Je suis un peut paumé du coup.

Je te mets ci-dessous le code complet et une image du UserForm "Add_BL"

Mon objectif serait de pouvoir faire, pour le même client, un BL avec 1 numéro unique mais plusieurs véhicules... Je ne sais pas si c'est clair ce que je te raconte mais te laisse voir par toi-même.

Désolé pour le casse tête et un grand merci pour ton aide.

Bandit
""""""""
Option Explicit
Public memoire As Integer

Private Sub Bouton_Ajouter_Click()
Dim Part_mark As String
Dim Part_designation As String
Dim Part_prix As Currency

If Me.Txt_Ref.ListIndex >= 0 And Me.Txt_Qte <> "" Then

'Bloquer si plus de 20 ref
If Me.Txt_List.ListCount >= 20 Then
MsgBox "Trop d'articles : Créer un nouveau BL STP"

Else

'Rechercher dans articles
Part_mark = WorksheetFunction.VLookup(Me.Txt_Ref, Sheets(2).Range("b:i"), 2, 0)
Part_designation = WorksheetFunction.VLookup(Me.Txt_Ref, Sheets(2).Range("b:i"), 3, 0)
Part_prix = WorksheetFunction.VLookup(Me.Txt_Ref, Sheets(2).Range("b:i"), 4, 0)

'Remplir la liste
With Me.Txt_List
.AddItem
.List(memoire, 0) = Me.Txt_Ref
.List(memoire, 1) = Part_mark
.List(memoire, 2) = Part_designation
.List(memoire, 3) = Me.Txt_Qte
.List(memoire, 4) = Part_prix
.List(memoire, 5) = Me.Txt_Qte * Part_prix
End With
memoire = memoire + 1

'Vider Ref et Qte
Me.Txt_Ref = ""
Me.Txt_Qte = ""
End If
End If
End Sub

Private Sub Bouton_Generer_Click()
Dim nombre_ligne As Integer
Dim ligne As Integer
Dim dl As Integer

If Me.Txt_List.ListCount > 0 And Me.Txt_Client.ListIndex >= 0 Then

'Demander une confirmation de BL
If MsgBox("Voulez-vous validez le BL ?", vbYesNo) = vbYes Then

Sheets(3).ListObjects(1).ListRows.Add
dl = Sheets(3).Range("b9999").End(xlUp).Row

'Afficher nos informations dans la base de donnée BL
Sheets(3).Range("B" & dl) = Me.Txt_Nr_BL.Caption
Sheets(3).Range("C" & dl) = CDate(Now())
Sheets(3).Range("F" & dl) = Me.Txt_Car
Sheets(3).Range("J" & dl) = Me.Txt_Client



nombre_ligne = Me.Txt_List.ListCount - 1


For ligne = 0 To nombre_ligne
Sheets(3).ListObjects(1).ListRows.Add
dl = Sheets(3).Range("b9999").End(xlUp).Row

'Afficher nos informations dans la base de donnée BL
Sheets(3).Range("B" & dl) = Me.Txt_Nr_BL.Caption
Sheets(3).Range("C" & dl) = CDate(Now())
Sheets(3).Range("D" & dl) = Me.Txt_List.List(ligne, 0)
Sheets(3).Range("E" & dl) = Me.Txt_List.List(ligne, 1)
Sheets(3).Range("F" & dl) = Me.Txt_List.List(ligne, 2)
Sheets(3).Range("G" & dl) = CInt(Me.Txt_List.List(ligne, 3))
Sheets(3).Range("H" & dl) = CCur(Me.Txt_List.List(ligne, 4))
Sheets(3).Range("I" & dl) = CCur(Me.Txt_List.List(ligne, 5))
Sheets(3).Range("J" & dl) = Me.Txt_Client
Sheets(3).Range("k" & dl) = Me.Txt_Car

Next ligne
Me.Txt_List.Clear
Me.Txt_Car = ""

End If

Else
MsgBox "Pas de BL Disponnible"

End If

End Sub

Private Sub Bouton_quitter_Click()
Sheets(8).Range("d20") = Sheets(8).Range("d20") + 1
Unload Add_BL
End Sub

Private Sub Txt_List_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If MsgBox("Effacer la ligne ?", vbYesNo) = vbYes Then
Me.Txt_List.RemoveItem Me.Txt_List.ListIndex
memoire = memoire - 1
End If
End Sub

Private Sub Txt_Qte_Change()

'Que des chiffres
If Not IsNumeric(Txt_Qte) And Txt_Qte <> "" Then
MsgBox "Uniquement des chiffres STP !"
Txt_Qte = ""
End If
End Sub

Private Sub UserForm_Initialize()
Me.Txt_Nr_BL.Caption = Sheets(8).Range("E20")
End Sub
""""""""""""""""""""""""""""
Capture d'écran 2018-09-30 10.43.53.png
Add_BL
Capture d'écran 2018-09-30 10.43.53.png (8.77 Kio) Vu 151 fois
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'201
Appréciations reçues : 444
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 30 septembre 2018, 14:31

Re,

Je veux bien regarder ton code quand j'aurai un moment mais j'apprécierais qu'il soit sous balises Code (et autant que possible indenté). :mrgreen:

D'autre part, examiner le code dans le fichier qui convient permet de voir ce qu'il fait dans ce fichier et d'apporter des modifications en vérifiant qu'elles conviennent. 8-)

Cordialement.
Avatar du membre
ric
Membre impliqué
Membre impliqué
Messages : 1'929
Appréciations reçues : 161
Inscrit le : 29 mai 2018
Version d'Excel : 365 fr

Message par ric » 30 septembre 2018, 14:39

Bonjour à tous,

Un petit coup de main à Bandit, pour qu'il n'aille pas en prison ... :P :P
Code sous balise avec indentation ...
Option Explicit
Public memoire As Integer

Private Sub Bouton_Ajouter_Click()
Dim Part_mark As String
Dim Part_designation As String
Dim Part_prix As Currency

   If Me.Txt_Ref.ListIndex >= 0 And Me.Txt_Qte <> "" Then

      'Bloquer si plus de 20 ref
      If Me.Txt_List.ListCount >= 20 Then
         MsgBox "Trop d'articles : Créer un nouveau BL STP"
      Else

         'Rechercher dans articles
         Part_mark = WorksheetFunction.VLookup(Me.Txt_Ref, Sheets(2).Range("b:i"), 2, 0)
         Part_designation = WorksheetFunction.VLookup(Me.Txt_Ref, Sheets(2).Range("b:i"), 3, 0)
         Part_prix = WorksheetFunction.VLookup(Me.Txt_Ref, Sheets(2).Range("b:i"), 4, 0)

         'Remplir la liste
         With Me.Txt_List
            .AddItem
            .List(memoire, 0) = Me.Txt_Ref
            .List(memoire, 1) = Part_mark
            .List(memoire, 2) = Part_designation
            .List(memoire, 3) = Me.Txt_Qte
            .List(memoire, 4) = Part_prix
            .List(memoire, 5) = Me.Txt_Qte * Part_prix
         End With
         memoire = memoire + 1

         'Vider Ref et Qte
         Me.Txt_Ref = ""
         Me.Txt_Qte = ""
      End If
   End If
End Sub

Private Sub Bouton_Generer_Click()
Dim nombre_ligne As Integer
Dim ligne As Integer
Dim dl As Integer

   If Me.Txt_List.ListCount > 0 And Me.Txt_Client.ListIndex >= 0 Then

      'Demander une confirmation de BL
      If MsgBox("Voulez-vous validez le BL ?", vbYesNo) = vbYes Then

         Sheets(3).ListObjects(1).ListRows.Add
         dl = Sheets(3).Range("b9999").End(xlUp).Row

         'Afficher nos informations dans la base de donnée BL
         Sheets(3).Range("B" & dl) = Me.Txt_Nr_BL.Caption
         Sheets(3).Range("C" & dl) = CDate(Now())
         Sheets(3).Range("F" & dl) = Me.Txt_Car
         Sheets(3).Range("J" & dl) = Me.Txt_Client

         nombre_ligne = Me.Txt_List.ListCount - 1

         For ligne = 0 To nombre_ligne
            Sheets(3).ListObjects(1).ListRows.Add
            dl = Sheets(3).Range("b9999").End(xlUp).Row

            'Afficher nos informations dans la base de donnée BL
            Sheets(3).Range("B" & dl) = Me.Txt_Nr_BL.Caption
            Sheets(3).Range("C" & dl) = CDate(Now())
            Sheets(3).Range("D" & dl) = Me.Txt_List.List(ligne, 0)
            Sheets(3).Range("E" & dl) = Me.Txt_List.List(ligne, 1)
            Sheets(3).Range("F" & dl) = Me.Txt_List.List(ligne, 2)
            Sheets(3).Range("G" & dl) = CInt(Me.Txt_List.List(ligne, 3))
            Sheets(3).Range("H" & dl) = CCur(Me.Txt_List.List(ligne, 4))
            Sheets(3).Range("I" & dl) = CCur(Me.Txt_List.List(ligne, 5))
            Sheets(3).Range("J" & dl) = Me.Txt_Client
            Sheets(3).Range("k" & dl) = Me.Txt_Car

         Next ligne
         Me.Txt_List.Clear
         Me.Txt_Car = ""
      End If
   Else
      MsgBox "Pas de BL Disponnible"
   End If
End Sub

Private Sub Bouton_quitter_Click()

   Sheets(8).Range("d20") = Sheets(8).Range("d20") + 1
   Unload Add_BL
End Sub

Private Sub Txt_List_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

   If MsgBox("Effacer la ligne ?", vbYesNo) = vbYes Then
      Me.Txt_List.RemoveItem Me.Txt_List.ListIndex
      memoire = memoire - 1
   End If
End Sub

Private Sub Txt_Qte_Change()

'Que des chiffres
   If Not IsNumeric(Txt_Qte) And Txt_Qte <> "" Then
      MsgBox "Uniquement des chiffres STP !"
      Txt_Qte = ""
   End If
End Sub

Private Sub UserForm_Initialize()
   Me.Txt_Nr_BL.Caption = Sheets(8).Range("E20")
End Sub 


ric
Un bon dépanneur : la touche F8 pour faire un Pas-à-Pas sur le code. :mrgreen:
B
Bandit
Jeune membre
Jeune membre
Messages : 20
Appréciation reçue : 1
Inscrit le : 30 septembre 2018
Version d'Excel : 2003

Message par Bandit » 30 septembre 2018, 16:24

Merci les gars,

Merci à tous pour votre aide.
B
Bandit
Jeune membre
Jeune membre
Messages : 20
Appréciation reçue : 1
Inscrit le : 30 septembre 2018
Version d'Excel : 2003

Message par Bandit » 1 octobre 2018, 12:13

Salut MFerrand,

Est-que tu peux me donner un exemple de ""réinitialisation des contrôles, avant réaffichage"" STP ?

En te remerciant par avance
B
Bandit
Jeune membre
Jeune membre
Messages : 20
Appréciation reçue : 1
Inscrit le : 30 septembre 2018
Version d'Excel : 2003

Message par Bandit » 2 octobre 2018, 11:05

Hello,

Après quelques heures d'essais j'ai utilisé :
Unload Me
Add_BL.Show

Entre End If et End Sub

ça fonctionne sauf que tout est réinitialisé et donc que je dois rechercher le client à nouveau.

Si y'a une astuce pour que le client reste ça serait super

Merci
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message