Microsoft 365 Rafraîchir listbox

[Marvin57]

Bonsoir tout le monde,

j'ai un petit soucis dans une listbox et malgré le temps passé sur les codes je sèche !

Dans le code ci-joint je peux choisir une catégorie d'une colonne de mon stock via un combobox et la filtrer en cliquant sur le bouton.

Sub Macro1()
' Macro1 Macro
    Sheets("STOCK").Activate
    ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=2, Criteria1:=Me.ComboBox14
        
End Sub

Jusqu'ici cela va. Mais j'aimerai qu'il me rafraîchisse la listbox en même temps afin de m'afficher le filtrage effectué sur l'onglet en question.

La listbox se nomme Listbox10
Le UserForm se nomme UserForm1

Pourriez vous me guider dans cette demande SVP.

Merci d'avance à vous.
Marvin57

 

[sousou]

Bonjour,
Avec un fichier ça peu peut-être le faire😉🙁

 

[ChTi160]

Bonsoir le Fil

Sub Macro1()
' Macro1 Macro
    Sheets("STOCK").Activate
ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=2, Criteria1:=Me.ComboBox14        
End Sub

Tu pourrais mettre

Sub Macro1()
' Macro1 Macro
 With Range("Tab_1").ListObject
     .Range.AutoFilter Field:=2, Criteria1:=Me.ComboBox14 
 End With   
End Sub

Depuis mon téléphone.
Jean marie

 

[job75]

Bonsoir Marvin57, sousou, ChTi160,

Complétez la macro ainsi :

Sub Macro1()
    Dim w As Worksheet, tablo
    Application.ScreenUpdating = False
    With [Tab_1].ListObject.Range
        .AutoFilter Field:=2, Criteria1:=Me.ComboBox14
        Set w = Workbooks.Add.Sheets(1) 'crée un document auxiliaire
        .SpecialCells(xlCellTypeVisible).Copy w.Cells(1)
    End With
    With w.UsedRange
        If .Rows.Count > 1 Then tablo = .Rows(2).Resize(.Rows.Count - 1)
    End With
    w.Parent.Close False
    Application.ScreenUpdating = True
    If IsArray(tablo) Then
        UserForm1.ListBox10.List = tablo
        UserForm1.Show
    End If
End Sub

A+

 

[job75]

Si le tableau structuré contient des formules il vaut mieux faire un Collage spécial Valeurs et Formats :

Sub Macro1()
    Dim w As Worksheet, tablo
    Application.ScreenUpdating = False
    With [Tab_1].ListObject.Range
        .AutoFilter Field:=2, Criteria1:=Me.ComboBox14
        Set w = Workbooks.Add.Sheets(1) 'crée un document auxiliaire
        .SpecialCells(xlCellTypeVisible).Copy
        w.Cells(1).PasteSpecial xlPasteValues 'Collage spécial-Valeurs
        w.Cells(1).PasteSpecial xlPasteFormats 'Collage spécial-Formats
        Application.CutCopyMode = 0
    End With
    With w.UsedRange
        If .Rows.Count > 1 Then tablo = .Rows(2).Resize(.Rows.Count - 1)
    End With
    w.Parent.Close False
    Application.ScreenUpdating = True
    If IsArray(tablo) Then
        UserForm1.ListBox10.List = tablo
        UserForm1.Show
    End If
End Sub

 

[Marvin57]

Si le tableau structuré contient des formules il vaut mieux faire un Collage spécial Valeurs et Formats :

Sub Macro1()
    Dim w As Worksheet, tablo
    Application.ScreenUpdating = False
    With [Tab_1].ListObject.Range
        .AutoFilter Field:=2, Criteria1:=Me.ComboBox14
        Set w = Workbooks.Add.Sheets(1) 'crée un document auxiliaire
        .SpecialCells(xlCellTypeVisible).Copy
        w.Cells(1).PasteSpecial xlPasteValues 'Collage spécial-Valeurs
        w.Cells(1).PasteSpecial xlPasteFormats 'Collage spécial-Formats
        Application.CutCopyMode = 0
    End With
    With w.UsedRange
        If .Rows.Count > 1 Then tablo = .Rows(2).Resize(.Rows.Count - 1)
    End With
    w.Parent.Close False
    Application.ScreenUpdating = True
    If IsArray(tablo) Then
        UserForm1.ListBox10.List = tablo
        UserForm1.Show
    End If
End Sub

Bonjour job75, sousou, ChTi160,

Merci à tous pour vos retour.

@ job75, j'ai placé votre dernier code dans mon fichier réel et cela fonctionne comme voulu. 👍 👍
Merci encore pour votre travail réalisé.

Marvin57

 

[job75]

Bonjour Marvin57, le forum,

Voyez le fichier joint.

Le fait de copier les formats permet de formater les dates dans la ListBox.

Par contre les formats monétaires sont ignorés, il faut formater la colonne concernée :

For i = 1 To UBound(tablo): tablo(i, 4) = Format(tablo(i, 4), "#,##0.00 €"): Next 'format monétaire

A+

 

[job75]

Bonjour ChTi160,

Je viens de tester, chez moi la macro InitialiseTableau beugue dès qu'on change la valeur de la ComboBox.

C'est dû au ListFillRange M1:M4, déplace le tableau sous la ligne 4, en B5:E12.

Par ailleurs tu affiches toutes les lignes du tableau après le filtrage, c'est une idée discutable.

A+

 

[job75]

Bonjour Marvin57, le forum,

Une autre solution :

Public flag As Boolean

Sub InitialiseTableau()
Dim P As Range, ncol%, critere$, n&, liste(), tablo, i&, j%
Set P = [Tab_1].ListObject.Range
ncol = P.Columns.Count
critere = P.Parent.ComboBox14
flag = True
P.AutoFilter 2, critere
flag = False
n = Application.CountIf(P.Columns(2), critere)
If n Then ReDim liste(1 To n, 1 To ncol)
tablo = P 'matrice, plus rapide
n = 0
For i = 2 To UBound(tablo)
    If tablo(i, 2) = critere Or critere = ">0" Then
        n = n + 1
        tablo(i, 4) = Format(tablo(i, 4), "#,##0.00 €")
        For j = 1 To ncol
            liste(n, j) = tablo(i, j)
        Next j
    End If
Next i
With UserForm1
    If n Then .ListBox10.List = liste Else .ListBox10.Clear
    .Show 0 'non modal
End With
End Sub

A+

 

[Marvin57]

Bonjour Marvin57, le forum,

Une autre solution :

Public flag As Boolean

Sub InitialiseTableau()
Dim P As Range, ncol%, critere$, n&, liste(), tablo, i&, j%
Set P = [Tab_1].ListObject.Range
ncol = P.Columns.Count
critere = P.Parent.ComboBox14
flag = True
P.AutoFilter 2, critere
flag = False
n = Application.CountIf(P.Columns(2), critere)
If n Then ReDim liste(1 To n, 1 To ncol)
tablo = P 'matrice, plus rapide
n = 0
For i = 2 To UBound(tablo)
    If tablo(i, 2) = critere Or critere = ">0" Then
        n = n + 1
        tablo(i, 4) = Format(tablo(i, 4), "#,##0.00 €")
        For j = 1 To ncol
            liste(n, j) = tablo(i, j)
        Next j
    End If
Next i
With UserForm1
    If n Then .ListBox10.List = liste Else .ListBox10.Clear
    .Show 0 'non modal
End With
End Sub

A+

Bonjour job75,

désolé pour ma réponse tardive, mais le travail est prioritaire.😉

Merci beaucoup pour votre dernier code. Je l'ai placé dans mon fichier réel et cela fonctionne très très bien.

Je vous souhaite une bonne journée et peut-être à bientôt.👋

Marvin57