Private Sub UserForm_Initialize()
Set Rng = [_FilterDataBase]
Dim Tmp(): ReDim Tmp(1 To [_FilterDataBase].Resize(, 1).SpecialCells(xlCellTypeVisible).Count)
For Each c In [_FilterDataBase].Resize(, 1).Offset(1).SpecialCells(xlCellTypeVisible)
i = i + 1: Tmp(i) = c.Row - Rng.Row + 1
Next c
TblBD = Application.Index(Rng, Application.Transpose(Tmp), _
Application.Transpose(Evaluate("Row(1:" & Rng.Columns.Count & ")")))
For i = 1 To UBound(TblBD) - 1: TblBD(i, 2) = Format(TblBD(i, 2), "dd/mm/yyyy"): Next i
Me.ListBox1.List = TblBD
End Sub
FantastiqueBonjour,
VB:Private Sub UserForm_Initialize() Set Rng = [_FilterDataBase] Dim Tmp(): ReDim Tmp(1 To [_FilterDataBase].Resize(, 1).SpecialCells(xlCellTypeVisible).Count) For Each c In [_FilterDataBase].Resize(, 1).Offset(1).SpecialCells(xlCellTypeVisible) i = i + 1: Tmp(i) = c.Row - Rng.Row + 1 Next c TblBD = Application.Index(Rng, Application.Transpose(Tmp), _ Application.Transpose(Evaluate("Row(1:" & Rng.Columns.Count & ")"))) For i = 1 To UBound(TblBD) - 1: TblBD(i, 2) = Format(TblBD(i, 2), "dd/mm/yyyy"): Next i Me.ListBox1.List = TblBD End Sub
Boisgontier
Dim Rng, TblBD(), NbCol
Private Sub UserForm_Initialize()
Set Rng = [_FilterDataBase]
Dim Tmp(): ReDim Tmp(1 To [_FilterDataBase].Resize(, 1).SpecialCells(xlCellTypeVisible).Count)
For Each c In [_FilterDataBase].Resize(, 1).Offset(1).SpecialCells(xlCellTypeVisible)
i = i + 1: Tmp(i) = c.Row - Rng.Row + 1
Next c
TblBD = Application.Index(Rng, Application.Transpose(Tmp), _
Application.Transpose(Evaluate("Row(1:" & Rng.Columns.Count & ")")))
For i = 1 To UBound(TblBD) - 1: TblBD(i, 2) = Format(TblBD(i, 2), "mmmm yy"): Next i
Me.ListBox1.List = TblBD
'-- en tête listbox
NbCol = Rng.Columns.Count
Me.ListBox1.ColumnCount = NbCol
EnteteListBox
End Sub
Private Sub TextBox1_Change()
ColRecherche = 1
clé = "*" & Me.TextBox1 & "*"
Dim Tbl()
For i = LBound(TblBD) To UBound(TblBD) - 1
If TblBD(i, ColRecherche) Like clé Then
n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
For k = LBound(TblBD, 2) To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
End If
Next i
If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.List = TblBD
End Sub
Sub EnteteListBox()
x = Me.ListBox1.Left + 8
y = Me.ListBox1.Top - 12
For i = 1 To NbCol
Set Lab = Me.Controls.Add("Forms.Label.1")
Lab.Caption = Rng.Cells(1, i)
Lab.Top = y
Lab.Left = x
Lab.Font.Bold = True
x = x + Rng.Columns(i).Width * 1.1
temp = temp & Rng.Columns(i).Width * 1.1 & ";"
Next
temp = Left(temp, Len(temp) - 1)
On Error Resume Next
Me.ListBox1.ColumnWidths = temp
End Sub
Private Sub UserForm_Initialize()
With Sheets("Liste")
.Cells.Delete
[A1].CurrentRegion.Copy .[A1]
.Rows(1).Delete
If .[A1] <> "" Then ListBox1.RowSource = .[A1].CurrentRegion.Address(External:=True)
End With
End Sub
Private Sub TextBox1_Change()
Dim ColRecherche%, clé$
ColRecherche = 1
clé = "*" & Me.TextBox1 & "*"
[A1].CurrentRegion.AutoFilter ColRecherche, clé
ListBox1.RowSource = ""
UserForm_Initialize
End Sub
C'est super MerciSans feuille intermédiaire:
VB:Dim Rng, TblBD(), NbCol Private Sub UserForm_Initialize() Set Rng = [_FilterDataBase] Dim Tmp(): ReDim Tmp(1 To [_FilterDataBase].Resize(, 1).SpecialCells(xlCellTypeVisible).Count) For Each c In [_FilterDataBase].Resize(, 1).Offset(1).SpecialCells(xlCellTypeVisible) i = i + 1: Tmp(i) = c.Row - Rng.Row + 1 Next c TblBD = Application.Index(Rng, Application.Transpose(Tmp), _ Application.Transpose(Evaluate("Row(1:" & Rng.Columns.Count & ")"))) For i = 1 To UBound(TblBD) - 1: TblBD(i, 2) = Format(TblBD(i, 2), "mmmm yy"): Next i Me.ListBox1.List = TblBD '-- en tête listbox NbCol = Rng.Columns.Count Me.ListBox1.ColumnCount = NbCol EnteteListBox End Sub Private Sub TextBox1_Change() ColRecherche = 1 clé = "*" & Me.TextBox1 & "*" Dim Tbl() For i = LBound(TblBD) To UBound(TblBD) - 1 If TblBD(i, ColRecherche) Like clé Then n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n) For k = LBound(TblBD, 2) To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k End If Next i If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.List = TblBD End Sub Sub EnteteListBox() x = Me.ListBox1.Left + 8 y = Me.ListBox1.Top - 12 For i = 1 To NbCol Set Lab = Me.Controls.Add("Forms.Label.1") Lab.Caption = Rng.Cells(1, i) Lab.Top = y Lab.Left = x Lab.Font.Bold = True x = x + Rng.Columns(i).Width * 1.1 temp = temp & Rng.Columns(i).Width * 1.1 & ";" Next temp = Left(temp, Len(temp) - 1) On Error Resume Next Me.ListBox1.ColumnWidths = temp End Sub
Boisgontier
Sacré job75!!!!!!!Bonjour KTM, JB, le forum,
Les en-têtes de colonnes de la ListBox sont dans des Labels.VB:Private Sub UserForm_Initialize() With Sheets("Liste") .Cells.Delete [A1].CurrentRegion.Copy .[A1] .Rows(1).Delete If .[A1] <> "" Then ListBox1.RowSource = .[A1].CurrentRegion.Address(External:=True) End With End Sub Private Sub TextBox1_Change() Dim ColRecherche%, clé$ ColRecherche = 1 clé = "*" & Me.TextBox1 & "*" [A1].CurrentRegion.AutoFilter ColRecherche, clé ListBox1.RowSource = "" UserForm_Initialize End Sub
A+