Autosize Column widths Listbox (1 Viewer)

[Zurvy]

hello all,

I was wondering whether there is an "easy" way to make the column widths of a list box to adjust to the largest peice of data under it.... without filling it in yourself in the design view... So in VB....

I know that there is the property COLUMNWIDTHS, and that you can adjust it by calling that property..


But how to make it the column width to adjust automatically to the largest piece of text in that column??

Any ideas would be welcome...
tnx
Zurvy

 

[RuralGuy]

You might try looking Here

 

[Zurvy]

Tnx RuralGuy,

What they have made on that site is not for a listbox, it's for a table/query viewed as Datasheet.

Anywayz, I made the function myself. (see below) The only thing is to find a good length to cm (or inch) ratio (colRatio) in order to set the columns to fit as best as possible for the largest piece of text under it.

For anybody who is interested in the funcion;
The function requires the list box as an input. Assign the result of the function to the ColumnWidths property and you're done.




Public Function SetColumnWidths(ctrList As Control) As String
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim colNum As Integer
Dim rowNum As Integer
Dim aryLen() As Single
Dim ctrValue As String
Dim colRatio As Single
Dim colWidths As String

'--- Find and store the length of the largest piece of text in each column ----

colNum = ctrList.ColumnCount - 1
rowNum = ctrList.ListCount - 1

ReDim aryLen(colNum) 'make the array's slots equal to the number of columns

For x = 0 To colNum ' for every column in list box
For y = 0 To rowNum ' for every row in the column (including heading)
ctrValue = ctrList.Column(x, y)
If Len(ctrValue) > aryLen(x) Then 'if the length of current record is larger than already stored
aryLen(x) = Len(ctrValue) 'store the largest value length
End If
Next y
Next x



'--- Set the column widths ---

colRatio = 0.1557

For i = 0 To colNum 'For each stored maximum lenght
If i = colNum Then
colWidths = colWidths & (aryLen(i) * colRatio) & "cm"
Else
colWidths = colWidths & (aryLen(i) * colRatio) & "cm;"
End If
Next i


'---Return the calculated value---

SetColumnWidths = colWidths

End Function




Zurvy

 

[RuralGuy]

Zurvy, I believe if you examine the modules in Stephan's db the information for ListBoxes is there.

 

[Zurvy]

Hey again,

tnx, I think i found it, but the code behind the list box is just too complex for me to understand on short notice. I think I will stick with my own.


However, I found something about how to determine the ratio as acurate as possible. I will give it a try...

Tnx again.

 

[RuralGuy]

No problem!

 

[bsacheri]

Zurvy,

Thanks for posting that concise example. It worked great for my purposes and was much simpler to implement than the VBA class provided by Stephen Lebans.

The attached image shows how this appears when applied to various reference tables.

I'm measuring by inches and for a Tahoma 8 font I found that a colRatio of 0.068 works well. I modified the code a bit so there is a minimum and maximum width.

Public Function SetColumnWidths(ctrList As Control) As String
' Return the ColumnWidths to Autofit the columns of the passed listbox control.
' Thanks to Zurvy for this concise example.
' https://access-programmers.co.uk/forums/showthread.php?t=91090

    Dim i As Integer
    Dim x As Integer
    Dim y As Integer
    Dim colNum As Integer
    Dim rowNum As Integer
    Dim aryLen() As Single
    Dim ctrValue As String
    Dim colRatio As Single
    Dim colWidths As String     ' Delimited string of widths
    Dim dblColWidth As Variant  ' Width calc for one column

    '--- Find and store the length of the largest piece of text in each column ----

    colNum = ctrList.ColumnCount - 1
    rowNum = ctrList.ListCount - 1

    ReDim aryLen(colNum) 'make the array's slots equal to the number of columns

    For x = 0 To colNum ' for every column in list box
        For y = 0 To rowNum ' for every row in the column (including heading)
            ctrValue = ctrList.Column(x, y)
            If Len(ctrValue) > aryLen(x) Then 'if the length of current record is larger than already stored
                aryLen(x) = Len(ctrValue) 'store the largest value length
            End If
        Next y
    Next x

    '--- Set the column widths ---

    'colRatio = 0.1557 ' for cm
    colRatio = 0.068 ' for inches

    For i = 0 To colNum 'For each stored maximum length
    
        dblColWidth = Round(aryLen(i) * colRatio, 3)
        If dblColWidth < 0.25 Then dblColWidth = 0.25   ' Set min width (inches)
        If dblColWidth > 5 Then dblColWidth = 5         ' Set max width (inches)
        If i = colNum Then
            colWidths = colWidths & dblColWidth & """"  ' or "cm"
        Else
            colWidths = colWidths & dblColWidth & """;" ' or "cm;"
        End If
    Next i

    '---Return the calculated value---
    SetColumnWidths = colWidths

End Function

Tnx RuralGuy,

What they have made on that site is not for a listbox, it's for a table/query viewed as Datasheet.

Anywayz, I made the function myself. (see below) The only thing is to find a good length to cm (or inch) ratio (colRatio) in order to set the columns to fit as best as possible for the largest piece of text under it.

For anybody who is interested in the funcion;
The function requires the list box as an input. Assign the result of the function to the ColumnWidths property and you're done.




Public Function SetColumnWidths(ctrList As Control) As String
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim colNum As Integer
Dim rowNum As Integer
Dim aryLen() As Single
Dim ctrValue As String
Dim colRatio As Single
Dim colWidths As String

'--- Find and store the length of the largest piece of text in each column ----

colNum = ctrList.ColumnCount - 1
rowNum = ctrList.ListCount - 1

ReDim aryLen(colNum) 'make the array's slots equal to the number of columns

For x = 0 To colNum ' for every column in list box
For y = 0 To rowNum ' for every row in the column (including heading)
ctrValue = ctrList.Column(x, y)
If Len(ctrValue) > aryLen(x) Then 'if the length of current record is larger than already stored
aryLen(x) = Len(ctrValue) 'store the largest value length
End If
Next y
Next x



'--- Set the column widths ---

colRatio = 0.1557

For i = 0 To colNum 'For each stored maximum lenght
If i = colNum Then
colWidths = colWidths & (aryLen(i) * colRatio) & "cm"
Else
colWidths = colWidths & (aryLen(i) * colRatio) & "cm;"
End If
Next i


'---Return the calculated value---

SetColumnWidths = colWidths

End Function




Zurvy

 

[Uncle Gizmo]

Thanks for posting that concise example. It worked great for my purposes

Due to a bug in the forum software this message was "unapproved" (hidden) for some considerable time. I have just approved it. I hope no one has been inconvenience too much! The new forum software no longer has this bug, so this problem should not reoccur.

 

[bsacheri]

Good timing. 2.5 years later and I was just revising the code that day.

 

[Uncle Gizmo]

Good timing. 2.5 years later and I was just revising the code that day.

It's really nice to hear that! The recent forum upgrade brought these hidden posts to light... There were over 300 of them, some going back 10 years or more. It was also apparent that OP's hadn't been active on the forum for several years. One option was to delete them all! However myself and another moderator Colin "Isladogs" decided to go back through the 300 and where appropriate, approve them! Your comment is evidence that this was the right decision, and worth the effort!