ben çà dépend comment tu l'obtiensUn approximation est possible avec la ListBox.Font.Size mais ça reste imprécis.
Je ne connais pas cette astuce. Tu peux expliquer ?pour les userform il y a l'astuce du label autosize
Ok mais le .ListCount ne me dit pas si tous les Items rentrent dans la ListBox (pas de ScrollBar verticale) ou pas (ScrollBar verticale présente).Vous avez .ListCount > une limite …
'function coded!by patricktoulon
'date 2022 for XLD
'know if the listbox has the vertical scrollbar
Option Explicit
Private Sub CommandButton1_Click()
Dim I&
ListBox1.Clear
For I = 1 To 10
ListBox1.AddItem Round((Rnd * 1000))
Next
End Sub
Private Sub CommandButton2_Click()
Dim I&
ListBox1.Clear
For I = 1 To 11
ListBox1.AddItem Round((Rnd * 1000))
Next
End Sub
Private Sub CommandButton3_Click()
MsgBox " a la scrollverticale : " & HasVerticalScrollBar(ListBox1)
End Sub
Function HasVerticalScrollBar(Ctrl As MSForms.Control)
Dim lab
Set lab = Me.Controls.Add("forms.Label.1", "X3Xy")
With lab
.Height = 2: .Caption = "A": .Font.Size = Ctrl.Font.Size: .Font.Name = Ctrl.Font.Name
.Font.Bold = Ctrl.Font.Bold: .BorderStyle = Ctrl.BorderStyle: .AutoSize = True
HasVerticalScrollBar = (.Height * Ctrl.ListCount) > Ctrl.Height
Me.Controls.Remove "X3Xy"
End With
End Function
'--------------------------
'Fonctionne pour les Controls ActiveX. Un Control.Activate sera effectué.
'Fonctionne pour les Controls UserForm ListBox pour lesquels un SetFocus sera effectué.
'NE fonctionne PAS Controls UserForm ComboBox.
'--------------------------
Public Function GetControlHandleByGetFocus(Ctl As Object) As LongPtr
Dim UserFormControl As MSForms.Control
Dim NbUserFormFocusControls As Integer
Dim TxB As MSForms.TextBox
'Parent is Worksheet
If TypeOf Ctl.Parent Is Worksheet Then
Ctl.Activate
GetControlHandleByGetFocus = GetFocus
'Parent is UserForm
Else
'Does NOT work for ComboBoxes
'If TypeOf Ctl Is MSForms.ComboBox Then Exit Function
'Count the number of Controls in the UserForm that can be SetFocus
On Error Resume Next
For Each UserFormControl In Ctl.Parent.Controls
UserFormControl.SetFocus
If Err.Number = 0 Then
NbUserFormFocusControls = NbUserFormFocusControls + 1
If NbUserFormFocusControls >= 2 Then Exit For
Else
Err.Clear
End If
Next UserFormControl
On Error GoTo 0
'Not 2 "focusable" Controls in the UserForm
If NbUserFormFocusControls < 2 Then
Set TxB = Ctl.Parent.Controls.Add("forms.TextBox.1", Name:="TextBoxForFocus")
End If
'Works ONLY if at least another "focusable" Control in the UserForm
Ctl.Enabled = False
Ctl.Enabled = True
'Not 2 "focusable" Controls in the UserForm
If NbUserFormFocusControls < 2 Then
Ctl.Parent.Controls.Remove "TextBoxForFocus"
End If
'Works ONLY if the Control did not have prior focus (reason why Ctl.Enabled = False / True)
Ctl.SetFocus
GetControlHandleByGetFocus = GetFocus
End If
End Function