largeur listbox dans UserForm

[ced91300]

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

 

[Lone-wolf]

Bonjour ced et bonne année

Reprend ton code, clique sur l'icone "Feuille" puis Code ensuite VB et colle le code dedans. Sépare aussi chaque Sub du formulaire. Comme tu l'a fait c'est pratiquement impossible à lire. Sinon un essai avec ceci

Dans Initialize du formulaire

Sheets("XXXX").Activate
With Activesheet
For i = 1 to .UsedRange.Columns.Count
ListBox1.List(ListBox1.ListCount - 1, i).ColumnWidths = .Cells(1, i).ColumnWidth
Next i
End With

Oubien
With ListBox1
.ColumnCount = 7
.ColumnWidths = "50;80;50;60;50;70;50"
End With


Et il y a une erreur à rectifier

Ncol = Rng.Columns.Count
TblTmp = Rng.Value
Ncol = Rng.Columns.Count - 1 Ici le nom à changer

 

[ced91300]

Bonjour ced et bonne année

Reprend ton code, clique sur l'icone "Feuille" puis Code ensuite VB et colle le code dedans. Sépare aussi chaque Sub du formulaire. Comme tu l'a fait c'est pratiquement impossible à lire. Sinon un essai avec ceci

Dans Initialize du formulaire

Sheets("XXXX").Activate
With Activesheet
For i = 1 to .UsedRange.Columns.Count
ListBox1.List(ListBox1.ListCount - 1, i).ColumnWidths = .Cells(1, i).ColumnWidth
Next i
End With

Oubien
With ListBox1
.ColumnCount = 7
.ColumnWidths = "50;80;50;60;50;70;50"
End With


Et il y a une erreur à rectifier

Ncol = Rng.Columns.Count
TblTmp = Rng.Value
Ncol = Rng.Columns.Count - 1 Ici le nom à changer

Bonjour Lone-wolf

meilleurs vœux à toi aussi pour cette nouvelle année

Merci pour ta réponse, désolé pour mon temps de réaction (plus d'ordi à la maison)

par contre je n'ai pas tout compris dans ta réponse, et je n'arrive pas à l'adapté (c'est un UserForm repris sur le net)

Ce que j'essai, c'est d'identifier dans ce BVA et plus particulièrement la ListBox ou sont les éléments qui définie actuellement la largeur des colonnes de celle-ci afin de pouvoir l'adapter
------------------------------------------------------------
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 UserForm_Initialize()
Set f = Sheets("bd")
Set Rng = f.Range("A2:AD" & f.[A65000].End(xlUp).Row) (j'ai changé le "N" en AD pour me prendre en compte + de colonnes)
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
___________________________________________________________________

Merci de ton aide

Cordialement

 

[Lone-wolf]

Bonjour ced

Mais tu va pas me dire que tu ne sais pas faire un copier-coller de ceci???

Dans Initialize du formulaire

Sheets("XXXX").Activate
With Activesheet
For i = 1 to .UsedRange.Columns.Count
ListBox1.List(ListBox1.ListCount - 1, i).ColumnWidths = .Cells(1, i).ColumnWidth
Next i
End With

 

[Lone-wolf]

Re Ced

Comme je suis sur un portable et donc petit écran, la dernière colonne visible est L. En mettant AD, j'ai eu de la chance que mon écran n'a pas explosé LOL

En PJ, un classeur exemple avec une macro de Roland que j'ai adapté. Il te suffit d'importer le module ou le copier, ensuite dans Initialize tu ajoute Call AutoSize_Columns.

 

[ced91300]

Bonjour Lone-wolf,

merci de ton aide, j'ai réussi avec ta deuxième solution
celle-ci :
With ListBox1
.ColumnCount = 7
.ColumnWidths = "50;80;50;60;50;70;50"
End With

la première ne fonctionnait pas

Encore merci

Cedric