CGU2022.
XLDnaute Junior
Bonjour a toutes et à tous, le temps est à la grisaille dans mon secteur mais heureusement les températures sont encore clémentes.
Ci dessous mes deux problèmes de ce jour:
1 -Dans vos archives auriez vous un code qui permet de trier automatiquement une listbox à partir de la colonne B ?
(au chargement).
2 - je souhaiterai pouvoir intervenir sur l'affichage de la liste box avec des checkbox
Aucun Checkbox affiche toutes les lignes 20 à 60
un Checkbox1 qui masque les lignes 20 à 30
un Checkbox2 qui masque les lignes 40 à 50
un Checkbox3 qui masque les lignes 50 à 60
Peux être travailler les checkbox au niveau de la plage de données??
Set Rng = f.range("a20:M" & f.[a65000].End(xlUp).Row)
sachant que celle ci peux est statique A20:M60
Qu'en pensez vous ?
Merci et bonne journée....
Ci dessous le code qui aliment ma listbox et la textbox qui permet d'effectuer une recherche intuitive.
Option Compare Text
Dim f, choix(), Rng, Ncol
Private Sub UserForm_Initialize()
Set f = ActiveSheet 'Feuille active
Set Rng = f.range("a17:M" & f.[a65000].End(xlUp).Row) 'base de données
decal = Rng.Row - 1
Ncol = Rng.Columns.Count
TblTmp = Rng.Value
Ncol = Rng.Columns.Count - 1
ReDim choix(1 To UBound(TblTmp))
For i = LBound(TblTmp) To UBound(TblTmp)
TblTmp(i, Ncol + 1) = i + decal
For k = 1 To Ncol
choix(i) = choix(i) & TblTmp(i, k) & "|"
Next k
choix(i) = choix(i) & (i + decal) & "|"
Next i
'Call Tri(TblTmp, 1, LBound(TblTmp), UBound(TblTmp))
Me.ListBox1.List = TblTmp
End Sub
Private Sub TextBoxRech_Change() 'TextBoxRech est la textbox de recherche
If Me.TextBoxRech <> "" Then 'TextBoxRech est la textbox de recherche
mots = Split(Trim(Me.TextBoxRech), " ")
Tbl = choix
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
n = 0: Dim b()
For i = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(i), "|")
n = n + 1: ReDim Preserve b(1 To Ncol + 1, 1 To n)
For k = 1 To Ncol
b(k, i + 1) = a(k - 1)
Next k
b(k, i + 1) = a(k - 1)
Next i
If n > 0 Then
ReDim Preserve b(1 To Ncol + 1, 1 To n + 1)
Me.ListBox1.List = Application.Transpose(b)
Me.ListBox1.RemoveItem n
End If
Else
UserForm_Initialize
End If
End Sub
Ci dessous mes deux problèmes de ce jour:
1 -Dans vos archives auriez vous un code qui permet de trier automatiquement une listbox à partir de la colonne B ?
(au chargement).
2 - je souhaiterai pouvoir intervenir sur l'affichage de la liste box avec des checkbox
Aucun Checkbox affiche toutes les lignes 20 à 60
un Checkbox1 qui masque les lignes 20 à 30
un Checkbox2 qui masque les lignes 40 à 50
un Checkbox3 qui masque les lignes 50 à 60
Peux être travailler les checkbox au niveau de la plage de données??
Set Rng = f.range("a20:M" & f.[a65000].End(xlUp).Row)
sachant que celle ci peux est statique A20:M60
Qu'en pensez vous ?
Merci et bonne journée....
Ci dessous le code qui aliment ma listbox et la textbox qui permet d'effectuer une recherche intuitive.
Option Compare Text
Dim f, choix(), Rng, Ncol
Private Sub UserForm_Initialize()
Set f = ActiveSheet 'Feuille active
Set Rng = f.range("a17:M" & f.[a65000].End(xlUp).Row) 'base de données
decal = Rng.Row - 1
Ncol = Rng.Columns.Count
TblTmp = Rng.Value
Ncol = Rng.Columns.Count - 1
ReDim choix(1 To UBound(TblTmp))
For i = LBound(TblTmp) To UBound(TblTmp)
TblTmp(i, Ncol + 1) = i + decal
For k = 1 To Ncol
choix(i) = choix(i) & TblTmp(i, k) & "|"
Next k
choix(i) = choix(i) & (i + decal) & "|"
Next i
'Call Tri(TblTmp, 1, LBound(TblTmp), UBound(TblTmp))
Me.ListBox1.List = TblTmp
End Sub
Private Sub TextBoxRech_Change() 'TextBoxRech est la textbox de recherche
If Me.TextBoxRech <> "" Then 'TextBoxRech est la textbox de recherche
mots = Split(Trim(Me.TextBoxRech), " ")
Tbl = choix
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
n = 0: Dim b()
For i = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(i), "|")
n = n + 1: ReDim Preserve b(1 To Ncol + 1, 1 To n)
For k = 1 To Ncol
b(k, i + 1) = a(k - 1)
Next k
b(k, i + 1) = a(k - 1)
Next i
If n > 0 Then
ReDim Preserve b(1 To Ncol + 1, 1 To n + 1)
Me.ListBox1.List = Application.Transpose(b)
Me.ListBox1.RemoveItem n
End If
Else
UserForm_Initialize
End If
End Sub