Option Compare Text
Dim f, TblBD, ColVisu(), NbCol, arrayColHead(), TblNoncontiG
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set Rng = f.Range("A2:P" & f.[A65000].End(xlUp).Row)
TblBD = Rng.Value ' rapidité
arrayColHead = Array(1, 2, 3, 5, 6, 7, 8, 10, 11, 12, 13, 15) ' Colonnes à visualiser (adapter)
TblNoncontiG = Application.Index(TblBD, Evaluate("ROW(" & 1 & ":" & Rng.Rows.Count & ")"), arrayColHead)
ReDim ColVisu(2, UBound(arrayColHead))
For i = 0 To UBound(arrayColHead)
ColVisu(0, i) = Rng.Cells(1, arrayColHead(i)).Offset(-1).Text
ColVisu(1, i) = Rng.Cells(1, arrayColHead(i)).Width
Next
' MsgBox "les entetes " & vbCrLf & Join(WorksheetFunction.Index(ColVisu, 1, 0), ";")
'MsgBox " le columnwidth " & vbCrLf & Join(WorksheetFunction.Index(ColVisu, 2, 0), ";")
With ListBox1
.List = TblNoncontiG
.ColumnCount = UBound(arrayColHead) + 1
.ColumnWidths = Join(WorksheetFunction.Index(ColVisu, 2, 0), ";")
End With
EnteteListBox ColVisu, ListBox1, True
End Sub
Sub EnteteListBox(TBL, LtBX, Optional separateurV As Boolean = False)
Dim X#, C&, ec#
X = LtBX.Left
ec = IIf(LtBX.TextAlign = 1, 6, 4) 'selectionmargin non dispo dans listbox
For C = 0 To UBound(TBL, 2)
With Me.Controls.Add("Forms.Label.1", , True)
.Left = X: .Height = 12: .Top = LtBX.Top - .Height + 2: .Width = TBL(1, C) + IIf(C = 0, ec, 0)
.BorderStyle = 1: .TextAlign = LtBX.TextAlign
'If C = UBound(TBL, 2) Then .Width = LtBX.Width + 10 - X
.Caption = TBL(0, C)
End With
'separateurs colonnes
If C > 0 And separateurV Then
With Me.Controls.Add("Forms.ListBox.1", "Sep0" & C, True)
.Top = LtBX.Top: .Left = X - 1: .Height = LtBX.Height: .Width = 1
.Enabled = False
.BorderStyle = 0: .BorderColor = vbBlack 'RGB(200, 200, 200)
End With
End If
X = X + TBL(1, C) + IIf(C = 0, ec, 0)
Next
End Sub