Vider ListBox
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
""""""""""""""""
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.
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
""""""""""""""""""""""""""""
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é).
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.
Cordialement.
Bonjour à tous,
Un petit coup de main à Bandit, pour qu'il n'aille pas en prison ...
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
Merci les gars,
Merci à tous pour votre aide.
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
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