largeur listbox dans UserForm

Bonjour à tous,

j'ai un soucis pour modifier la largeur des colonnes dans une ListBox , je n'arrive pas à identifier ou je dois changer les éléments dans la macro ci-dessous?

Merci
cordialement

Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set Rng = f.Range("A2:AD" & f.[A65000].End(xlUp).Row) 'changé le n en AD
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) & "|"
If K >= 3 And K <= 5 Then TblTmp(i, K) = Format(TblTmp(i, K), "000000")
Next K
choix(i) = choix(i) & (i + decal) & "|"
Next i
Call TriS(choix, 1, UBound(choix))
Call Tri(TblTmp, 1, LBound(TblTmp), UBound(TblTmp))
Me.ListBox1.List = TblTmp
'Me.Enreg = f.[A65000].End(xlUp).Row + 1
End Sub
Private Sub TextBoxRech_Change()
If Me.TextBoxRech <> "" Then
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)
If K >= 3 And K <= 5 Then b(K, i + 1) = Format(b(K, i + 1), "0000000")
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
Private Sub ListBox1_Click()
For K = 1 To Ncol
Me("textBox" & K) = Me.ListBox1.Column(K - 1)
Next K
Me.Enreg = Me.ListBox1.Column(Ncol)
End Sub
Private Sub b_modif_Click()
b_valid.Locked = False
b_valid.ForeColor = vbRed
End Sub
Private Sub B_consult_Click()
b_valid.Locked = True
b_valid.ForeColor = vbYellow
End Sub
Private Sub b_ajout_Click()
raz
Me.Enreg = f.[A65000].End(xlUp).Row + 1
b_valid.Locked = False
b_valid.ForeColor = vbRed
End Sub
Private Sub b_valid_Click()
If Me.Enreg <> "" And Me.TextBox1 <> "" Then
NoEnreg = Me.Enreg
For K = 1 To Ncol
x = Replace(Me("textBox" & K), " ", "")
If IsNumeric(x) Then
f.Cells(NoEnreg, K) = Val(x)
Else
f.Cells(NoEnreg, K) = Me("textBox" & K)
End If
Next K
raz
Me.Enreg = ""
UserForm_Initialize
End If
End Sub
Private Sub B_sup_Click()
If MsgBox("Etes vous sûr de suppimer " & f.Cells(Enreg, 1) & "?", vbYesNo) = vbYes Then
Enreg = Me.Enreg
f.Cells(Enreg, 1).Resize(, Ncol).Delete Shift:=xlUp
raz
Me.Enreg = ""
UserForm_Initialize
End If
End Sub
Sub raz()
For K = 1 To Ncol
Me("textBox" & K) = ""
Next K
Me.TextBox1.SetFocus
End Sub
Sub Tri(a, ColTri, gauc, droi) ' Quick sort
ref = a((gauc + droi) \ 2, ColTri)
g = gauc: d = droi
Do
Do While a(g, ColTri) < ref: g = g + 1: Loop
Do While ref < a(d, ColTri): d = d - 1: Loop
If g <= d Then
For K = LBound(a, 2) To UBound(a, 2)
temp = a(g, K): a(g, K) = a(d, K): a(d, K) = temp
Next K
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, ColTri, g, droi)
If gauc < d Then Call Tri(a, ColTri, gauc, d)
End Sub
Sub TriS(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call TriS(a, g, droi)
If gauc < d Then Call TriS(a, gauc, d)
End Sub