XL 2013 Filtrer une listbox avec une combobox

[Jdamine]

Bonsoir à tous,

Depuis quelques temps je travaille sur les Userform pour gérer des bases de données.
J'ai un nouveau besoin: filtrer une base de données dans la listbox avec un combobox.
Ca dépasse mes connaissances, donc je trouve des codes sur des forums et j'adapte mais ça ne se passe pas comme prévu.
La combobox ne se charge pas et la listbox non plus.
Je vous demande donc un coup de main pour trouver le problème afin de pouvoir filtrer la listbox avec la combobox
Merci.

Private Sub cborefcons_Change()
Dim LastLig As Long
Dim Code As String
Dim c As Range

Application.ScreenUpdating = False
With Me.lstcontr
.Clear
.Visible = False
End With

Code = Me.cborefcons.Value
If Me.cborefcons.ListIndex > -1 Then
With Worksheets("Contrats")
.AutoFilterMode = False
LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:=Code
For Each c In .Range("B2:B" & LastLig).SpecialCells(xlCellTypeVisible)
With Me.lstcontr
.AddItem c
.List(.ListCount - 1, 1) = c.Offset(0, 1)
.List(.ListCount - 1, 2) = c.Offset(0, 2)
End With
Next c
Me.lstcontr.Visible = True
.AutoFilterMode = False
End With
End If
End Sub

 

[job75]

Bonjour Jdamine, bienvenue sur XLD, le forum,

C'est sûr qu'on trouve de tout sur les forums

Pour ce qui est de la ComboBox elle ne se remplit pas car il ne faut pas écrire :

Private Sub frmsaisiecontrat_Initialize()

mais :

Private Sub UserForm_Initialize()

De plus dans cette macro utilisez ce code :

'Application.ScreenUpdating = False 'ne sert à rien
With Worksheets("Contrats")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    cborefcons.Clear
    For j = 2 To LastLig
        If .Range("A" & j) <> "" Then
            On Error Resume Next
            cborefcons = .Range("A" & j)
            If cborefcons.ListIndex = -1 Then cborefcons.AddItem .Range("A" & j) Else .[A1].AutoFilter
            cborefcons = ""
        End If
    Next j
End With

PS : pourquoi le fichier s'appelle MAC, vous êtes sur MAC ?

A+

 

[job75]

Bonjour Jdamine,

Si l'on veut des en-têtes de colonnes sur la ListBox le plus simple est d'utiliser sa propriété RowSource.

Donc d'utiliser une feuille auxiliaire que l'on pourra masquer, voyez ce fichier (2) et les codes :

Private Sub ComboBox1_Change()
Dim w As Worksheet, h&
Set w = Sheets("Auxiliaire")
w.Cells.Clear
With Sheets("Contrats").[A1].CurrentRegion
    .AutoFilter 1, IIf(ComboBox1 = "", "*", ComboBox1)
    .Copy w.[A1]
    .AutoFilter
End With
h = w.UsedRange.Rows.Count
If h = 1 Then h = 2
w.UsedRange.Offset(1).Resize(h - 1).Name = "ListBoxList"
ListBox1.RowSource = "ListBoxList"
End Sub

Private Sub UserForm_Initialize()
Dim P As Range, i&, cw$

Set P = Sheets("Contrats").[A1].CurrentRegion
With ListBox1
    .ColumnCount = P.Columns.Count
    P.Columns.AutoFit
    For i = 1 To .ColumnCount
        cw = cw & P.Columns(i).Width * (.Width - 20) / P.Width & ";"
    Next i
    .ColumnWidths = cw
    .ColumnHeads = True
End With

ComboBox1_Change
Set P = Sheets("Auxiliaire").[A1].CurrentRegion
If P.Rows.Count = 1 Then Exit Sub
P.Sort P(1), xlAscending, Header:=xlYes 'tri
With ComboBox1
    .ColumnCount = 1
    .List = P(2, 1).Resize(P.Rows.Count - 1, 2).Value 'au moins 2 éléments
    For i = .ListCount - 1 To 1 Step -1
        If LCase(.List(i)) = LCase(.List(i - 1)) Then .RemoveItem i 'supprime les doublons
    Next
End With
ComboBox1_Change 'remet dans l'ordre initial
End Sub

Nota : la ComboBox était vérolée, je l'ai remplacée.

A+

 

[job75]

Sur MAC je crois que la propriété RowSource n'existe pas.

Voyez ce fichier (3) qui utilise la propriété List et une 2ème ListBox pour les en-têtes de colonnes.