XL 2016 largueur des colonnes listbox

[gothc]

Bonjour je cherche comment faire pour modifier la largueur des colonnes de ma listbox de Nom trav
j'ai 4 colonnes sur ma listbox trav Merci de votre aide



Option Explicit

Private Sub CommandButton1_Click()
datt = Date
trav.Clear
Label24 = DateAdd("d", -Val(recul), datt)
End Sub

Private Sub CommandButton10_Click()
If machh.ListIndex = -1 Then Exit Sub
pann = finf4 + 1
act = finf1 + 1
UserForm4.Show 0
dico3
If opt = 2 Then If indi = True Then dep.CommandButton3 = True Else dep.CommandButton2 = True
If opt = 1 Then If indi = True Then dep.CommandButton5 = True Else dep.CommandButton4 = True
End Sub

Private Sub CommandButton11_Click()
If dep.machh.ListIndex = -1 Then Exit Sub
chang = True
dep.Hide
UserForm2.Show 0
End Sub

Private Sub CommandButton12_Click()
valid = 0
MDP.Show
If valid Then
Dim a As Byte
Dim x As Long
If machh.ListIndex = -1 Then Exit Sub
a = MsgBox(mess(4), vbYesNo, mess(5))
If a = 7 Then Exit Sub
Feuil2.Rows(xmachh(nomach)).Delete
For x = finf1 To 2 Step -1
If Feuil1.Cells(x, 1) = nomach Then Feuil1.Rows(x).Delete
Next
For x = finf4 To 2 Step -1
If Feuil4.Cells(x, 2) = nomach Then Feuil4.Rows(x).Delete
Next
dico1
dico2
dico3
unclic
trav.Clear
End If
End Sub

Private Sub CommandButton13_Click()
Dim a As Integer
Dim b As String
Dim fin As Long
fin = finf8 + 1
With Feuil8
a = Application.WorksheetFunction.Max(.Range("A:A")) + 1
b = InputBox(mess(16))
If b = "" Then Exit Sub
.Cells(fin, 1) = a: .Cells(fin, 2) = b
End With
dico4
End Sub

Private Sub CommandButton14_Click()
If Feuil3.AutoFilterMode Then Feuil3.Cells.AutoFilter
UserForm6.Show 0
dico2
End Sub

Private Sub CommandButton15_Click()
dep.Hide
UserForm7.Show 0
End Sub

Private Sub CommandButton18_Click()
UserForm8.Show 0
End Sub

Private Sub CommandButton19_Click()
valid = 0
MDP.Show
If valid Then UserForm9.Show 0
End Sub

Private Sub CommandButton2_Click()
Dim i&, tr As Integer, pass As Boolean, datt1 As Date, dat As Date, moyen As Double
cont = "": tr = 0
If IsDate(datt) = False Then MsgBox (mess(3)): trav.Clear: Exit Sub
datt1 = DateAdd("d", -Val(recul), datt)
trav.Clear
With Feuil1
For i = 2 To finf1
If .Cells(i, 1) > tr Then tr = .Cells(i, 1): pass = True: moyen = xmoy(tr): If moyen = 0 Then moyen = 1
If interv.ListIndex = -1 Or .Cells(i, 12) = interv Then
If (xmaint3(Feuil1.Cells(i, 2)) = False And IsDate(Feuil1.Cells(i, 5)) = True) Or xmaint3(Feuil1.Cells(i, 2)) = True Then
If xmaint3(Feuil1.Cells(i, 2)) = False Then dat = Feuil1.Cells(i, 5) Else dat = DateAdd("d", Int(Feuil1.Cells(i, 4) / moyen), Feuil1.Cells(i, 3))
If dat <= CDate(datt) And dat >= CDate(datt1) Then
If pass = True Then trav.AddItem xmach(tr): pass = False Else trav.AddItem
trav.List(trav.ListCount - 1, 1) = xmaint1(.Cells(i, 2))
trav.List(trav.ListCount - 1, 2) = xmaint2(.Cells(i, 2))
trav.List(trav.ListCount - 1, 3) = i
trav.List(trav.ListCount - 1, 4) = xinter(.Cells(i, 12))
End If
End If
End If
Next i
End With
machh.ListIndex = -1
trav.ListIndex = -1
indi = False
DoEvents
End Sub

Private Sub CommandButton20_Click()
If Feuil22.Range("a3") = InputBox("Code ", "Code administrateur") Then Unload Me: UserForm10.Show
End Sub

Private Sub CommandButton3_Click()
Dim i As Long
Dim tr As String
Dim datt1 As Date
Dim dat As Date
Dim moyen As Double
If IsDate(datt) = False Then MsgBox (mess(3)): trav.Clear: Exit Sub
datt1 = DateAdd("d", -Val(recul), datt)
If machh.ListIndex = -1 Then trav.Clear:: Exit Sub
cont = Format(xcont(nomach), b$)
tr = xmach(machh)
moyen = xmoy(nomach): If moyen = 0 Then moyen = 1
trav.Clear
With Feuil1
For i = 2 To finf1
If .Cells(i, 1) = nomach And (interv.ListIndex = -1 Or .Cells(i, 12) = interv) Then
If (xmaint3(Feuil1.Cells(i, 2)) = False And IsDate(Feuil1.Cells(i, 5)) = True) Or xmaint3(Feuil1.Cells(i, 2)) = True Then
If xmaint3(Feuil1.Cells(i, 2)) = False Then dat = Feuil1.Cells(i, 5) Else dat = DateAdd("d", Int(Feuil1.Cells(i, 4) / moyen), Feuil1.Cells(i, 3))
If dat <= CDate(datt) And dat >= CDate(datt1) And Feuil1.Cells(i, 18) = "" Then
trav.AddItem tr
trav.List(trav.ListCount - 1, 1) = xmaint1(.Cells(i, 2))
trav.List(trav.ListCount - 1, 2) = xmaint2(.Cells(i, 2))
trav.List(trav.ListCount - 1, 3) = i
trav.List(trav.ListCount - 1, 4) = xinter(.Cells(i, 12))
tr = ""
End If
End If
End If
Next i
End With
indi = True
trav.ListIndex = -1
End Sub

Private Sub CommandButton4_Click()
Dim i As Long
Dim tr As Integer
Dim pass As Boolean
trav.Clear
tr = 0
cont.Caption = ""
With Feuil1
For i = 2 To finf1
If .Cells(i, 1) <> tr Then tr = .Cells(i, 1): pass = True
If interv.ListIndex = -1 Or .Cells(i, 12) = interv And Feuil1.Cells(i, 18) = "" Then
If pass = True Then trav.AddItem xmach(tr): pass = False Else trav.AddItem
trav.List(trav.ListCount - 1, 1) = xmaint1(.Cells(i, 2))
trav.List(trav.ListCount - 1, 2) = xmaint2(.Cells(i, 2))
trav.List(trav.ListCount - 1, 3) = i
trav.List(trav.ListCount - 1, 4) = xinter(.Cells(i, 12))
End If
Next i
End With
machh.ListIndex = -1
trav.ListIndex = -1
indi = False: tout = True
DoEvents
End Sub

Private Sub CommandButton5_Click()
Dim i As Long
Dim tr As String
If machh.ListIndex = -1 Then trav.Clear: Exit Sub
tr = xmach(machh)
trav.Clear
cont.Caption = Format(xcont(machh), b$)
With Feuil1
For i = 2 To finf1
If .Cells(i, 1) = nomach Then
If interv.ListIndex = -1 Or .Cells(i, 12) = interv Then
trav.AddItem tr
trav.List(trav.ListCount - 1, 1) = xmaint1(.Cells(i, 2))
trav.List(trav.ListCount - 1, 2) = xmaint2(.Cells(i, 2))
trav.List(trav.ListCount - 1, 3) = i
trav.List(trav.ListCount - 1, 4) = xinter(.Cells(i, 12))
tr = ""
End If
End If
Next i
End With
indi = True
trav.ListIndex = -1
tout = True
End Sub

Private Sub CommandButton6_Click()
If machh.ListIndex = -1 Then MsgBox (mess(6)): Exit Sub
UserForm1.machh = xmach(nomach)
UserForm1.Show
End Sub

Private Sub CommandButton7_Click()
If Feuil22.Range("a1") = True Then ThisWorkbook.Save
End
End Sub

Private Sub CommandButton8_Click()
Dim x As Integer
Dim y As Byte
With Feuil7
.Range("A2:d1000").ClearContents
For x = 0 To trav.ListCount - 1
For y = 0 To 2
.Cells(x + 2, y + 1) = trav.List(x, y)
Next
.Cells(x + 2, 4) = trav.List(x, 4)
Next
dep.Hide
.PrintPreview
End With
dep.Show
End Sub

Private Sub CommandButton9_Click()
valid = 0
MDP.Show
If valid Then
Dim fin As Long, a As String
fin = finf2 + 1
nomach = WorksheetFunction.Max(Feuil2.Range("a2:a10000")) + 1
a = nomach
machine.Add a, fin
UserForm3.Show
dico1
End If
End Sub

Private Sub cont_Click()
Dim aa As Double
Dim dd As Byte
If machh.ListIndex = -1 Then Exit Sub
aa = Val(InputBox(mess(11)))
If aa = 0 Then Exit Sub
If xcont(nomach) > aa Then
dd = MsgBox(mess(10), vbYesNo)
If dd = 7 Then Exit Sub
End If
Feuil2.Cells(xmachh(nomach), 10) = aa
cont = aa
Select Case opt
Case 1
CommandButton5 = True: Exit Sub
Case 2
CommandButton3 = True: Exit Sub
End Select
End Sub

Private Sub datt_AfterUpdate()
trav.Clear
If IsDate(datt) = False And datt > "" Then MsgBox (mess(3)): trav.Clear Else Label24 = DateAdd("d", -Val(recul), datt)
End Sub

Private Sub interv_Change()
If opt = 2 Then If indi = True Then dep.CommandButton3 = True Else dep.CommandButton2 = True
If opt = 1 Then If indi = True Then dep.CommandButton5 = True Else dep.CommandButton4 = True
End Sub


Private Sub machh_Click()
trav.Clear
nomach = dep.machh.List(machh.ListIndex, 0)
cont.Caption = Format(xcont(nomach), b$)
Select Case opt
Case 1
CommandButton5 = True: Exit Sub
Case 2
CommandButton3 = True: Exit Sub
End Select
indi = True
End Sub

Private Sub machh_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If machh.ListIndex = -1 Then Exit Sub
nomach = dep.machh.List(machh.ListIndex, 0)
UserForm3.Show 0
End Sub

Private Sub OptionButton1_Click()
machh.ListIndex = -1
opt = 2
trav.Clear
If datt = "" Then datt = Date
End Sub

Private Sub OptionButton2_Click()
machh.ListIndex = -1
opt = 1
trav.Clear
End Sub

Private Sub recul_AfterUpdate()
Feuil22.Range("b1") = Val(recul)
Label24 = DateAdd("d", -Val(recul), datt)
trav.Clear
End Sub

Private Sub trav_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If xmachh(nomach) = 65000 Then Exit Sub
If trav.ListIndex = -1 Then Exit Sub
If maint = 0 Then
cpann = True
If xpann(nopann) = 65000 Then Exit Sub
pann = xpann(nopann): UserForm4.Show 0
Else
With UserForm5
.machh = xmach(nomach)
.trav1 = xmaint1(maint)
.trav2 = xmaint2(maint)
.dat1 = Feuil1.Cells(act, 3)
.dat2 = Feuil1.Cells(act, 5)
.per1 = Feuil1.Cells(act, 4)
.Label1892 = Feuil1.Cells(act, 11)
.inter1 = xinter(Val(Feuil1.Cells(act, 7)))
.per = Feuil1.Cells(act, 4)
.compt = Format(Feuil1.Cells(act, 6).Value, b$)
.datt = ""
.inter = ""
.copt = ""
.TextBox1 = ""
End With
nochange = True
UserForm5.Show 0
End If
End Sub

Private Sub trav_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Dim a As Byte
If trav.ListIndex = -1 Then Exit Sub
act = dep.trav.List(trav.ListIndex, 3)
With Feuil1
If Left(.Cells(act, 2), 1) = "p" Then maint = 0: nopann = Mid(.Cells(act, 2), 2) Else maint = .Cells(act, 2)
nomach = .Cells(act, 1)
End With
If Button = 2 Then a = MsgBox(mess(9), vbYesNo)
If a = 6 Then
Feuil1.Rows(act).Delete
trav.RemoveItem (trav.ListIndex)
End If
End Sub

Private Sub UserForm_Initialize()
Dim tablo
Macro1
messag
Set machine = CreateObject("Scripting.Dictionary")
Set maintt = CreateObject("Scripting.Dictionary")
Set panne = CreateObject("Scripting.Dictionary")
Set zinter = CreateObject("Scripting.Dictionary")
dico1
dico2
dico3
dico4
OptionButton2 = True
datt = Date
recul = Feuil22.Range("b1")
Label24 = DateAdd("d", -Val(recul), datt)
moyen = Me.Height / (Application.Height - 20)
plus
unclic
With Feuil8
tablo = .Range("a2:c" & .Range("a65536").End(xlUp).Row)
interv.List = tablo
End With
dep.trav.IntegralHeight = False
End Sub

Public Sub unclic()
Dim derr As Integer
Dim i As Long
machh.Clear
trav.Clear
cont = ""
With Feuil2
For i = 2 To finf2
derr = machh.ListCount
machh.AddItem .Cells(i, 1)
machh.List(derr, 1) = .Cells(i, 2): machh.List(derr, 2) = i
machh.List(derr, 3) = .Cells(i, 3)
Next
End With
machh.ColumnWidths = "0;30;0;100"
machh.ColumnCount = 4
End Sub

 

[sylvanu]

Bonjour Gothc,
Utilisez les balises </> pour insérer votre code, c'est plus lisible.
Sinon pour la largeur de vos colonnes, voici trois beaux exemples :

AutoSize des colonnes d'une ListBox

Bonjour à tous, Je devrais alimenté une ListBox depuis un tableau, et j'aimerais bien avoir un auto ajustement des colonnes de ma liste selon la largeur des données du tableau. Merci.

www.excel-downloads.com

[XL-2013] Largeur des colonnes dans une ListBox - Macros et VBA Excel

Jutilise un code bien fait et qui fonctionne super bien dans mon application. Jai reçu ce code (qui un petit fichier Excel) de Thautheme (encore un merci pour ce code ). Aujourdhui il se pose un problème,

www.developpez.net

Listbox taille des colonnes

Bonjour, je récupère des informations dans une listbox et je suis confronté au cas "quelle taille pour les colonnes". Compte-tenu que le texte est variable s...

forum.excel-pratique.com

 

[sylvanu]

Vous voulez parler de largeur, non de longueur ?
Dans le fil LIEN, c'est bien expliqué ... mais c'est compliqué.
Il faut bien choisir sa police, de préférence Courrier car tous les caractères ont même "largeur" puis compter le nombre max de caractères possible et appliquer un facteur multiplicatif par tâtonnement.
Il n'y a pas de "formule magique" semble t-il, genre AutoFit.

 

[gothc]

oui largeur je veux dire
je vais voir votre lien

 

[gothc]

Merci J'ai trouvé avec cette fontion
trav.ColumnWidths = "40;150;200;00;100"
trav.ColumnCount = 5
Bonne journée

 

[patricktoulon]

bonjour
sans connaitre le font name,le font size et autre il y a bien un moyen
avec un label temporaire dynamique et autofit

 

[patricktoulon]

peut etre que ceci va vous aiguiller

Private Sub CommandButton1_Click()
    Dim tabl() As Variant, Lx, I&, C&, Lab
    ReDim tabl(0 To ListBox1.ColumnCount - 1)
    MsgBox UBound(tabl)
    Set Lx = ListBox1
    Set Lab = Me.Controls.Add("Forms.Label.1", "sizeur", True)
    With Lab
        .Font.Name = Lx.Font.Name: .Font.Size = Lx.Font.Size: .AutoSize = True: .Height = 20: .BorderStyle = 0
    End With
    With Lx
        For I = 0 To .ListCount - 1: For C = 0 To .ColumnCount - 1
                If Len(tabl(C)) < Len(.List(I, C)) Then tabl(C) = .List(I, C)
            Next: Next
        For I = 0 To UBound(tabl): Lab.Caption = tabl(I): tabl(I) = Lab.Height + 2: Next
        .ColumnWidths = Join(tabl, ";")
    End With
    Me.Controls.Remove Lab.Name
End Sub

demo

 

[gothc]

Merci Patrick

 

[patricktoulon]

re
de rien je l'ai amélioré car avec le height et les sauts de ligne c’était moins précis
et je l'ai argumenté (réutilisation pour X listboxs)
donc

Private Sub ColumnAutoSize(Lx)
    Dim tabl() As String, I&, C&, Lab
    ReDim tabl(0 To ListBox1.ColumnCount - 1)
          Set Lab = Me.Controls.Add("Forms.Label.1", "sizeur", True)
    With Lab
         .Height = 10:  .Font.Name = Lx.Font.Name: .Font.Size = Lx.Font.Size: .AutoSize = True: .BorderStyle = 0
    End With
    With Lx
        For I = 0 To .ListCount - 1
        For C = 0 To .ColumnCount - 1: tabl(C) = IIf(Len(tabl(C)) < Len(.List(I, C)), .List(I, C), tabl(C)): Next
        Next
        For I = 0 To UBound(tabl)
            With Lab: .AutoSize = False: .Caption = "": .Width = 150: .Caption = tabl(I): .AutoSize = True: End With
            tabl(I) = Lab.Width + 8
        Next
        
        .ColumnWidths = Join(tabl, ";")
    End With
    Me.Controls.Remove Lab.Name
End Sub

Private Sub UserForm_Activate()
    With ListBox1
        .List = [A1:D5].Value
        .ColumnCount = 4
    End With
    ColumnAutoSize ListBox1
End Sub

la c'est mieux