JKP Application Development Services.

Microsoft Office Application Development

UserForm Setup

Up • UserForm Setup • How It Works • Module Code & Conclusion

• •

Search

Zoeken

Go to	Ga Naar
Home Up

Donate	Donaties
Did you find something helpful on my site? Consider a donation! Heeft u iets gevonden waar u wat aan had? Overweeg dan een donatie!

Showing An Array On A Form; Autosizing ColumnWidths Of A ListBox

UserForm Setup

I devised a userform that looks like this:

The form contains these controls (and I list the most important properties too):

Controlname	Type	AutoSize	Cancel	Caption	Default	TabIndex	Tag	WordWrap	Visible
lbxTable	ListBox					0	WH		TRUE
cmbClose	CommandButton	FALSE	TRUE	Close	TRUE	1	TL		TRUE
lblTableTitle	Label	FALSE		Label1		2			TRUE
lblHidden	Label	TRUE		lblHidden		3		False	FALSE

To be able to use the form I have added a couple of properties and methods to use:

Property/method	Description
Table (Variant)	Used to pass the table you want displayed (expects a variant)
Title (string)	The title to show above the listbox
AutoColWidths (Boolean)	To tell the form Whether or not to autosize the column widths
FormWidth and FormHeight (Double)	Used by the CFormResizer class (see the sample file) to handle resizing of the form
Initialise	Initialises the form: reads the table, puts it on the listbox and starts the column resize routine

Which all sums up to this VBA code behind the UserForm:

'-------------------------------------------------------------------------
' Module    : ufShowTable
' Company   : JKP Application Development Services (c)
' Author    : Jan Karel Pieterse (www.jkp-ads.com)
' Created   : 14-5-2008
' Purpose   : Code to handle showing of table on this userform
'-------------------------------------------------------------------------
Option Explicit

Private mvTable As Variant
Private mbAutoColWidths As Boolean

Private mdFormWidth As Double
Private mdFormHeight As Double

'Code for form resizing courtesy:
'Stephen Bullen, www.oaltd.co.uk
'Rob Bovey, www.appspro.com

'Declare an object for the CFormResizer class to handle resizing for this form
Dim mclsResizer As CFormResizer

'----------------------EVENT CODE ----------------------

Private Sub cmbClose_Click()
    Me.Hide
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: When the form is resized, the UserForm_Resize event
'           is raised, which we just pass on to the Resizer class
'
' Date          Developer       Action
' --------------------------------------------------------------
' 07 Oct 04     Stephen Bullen  Initial version
'
Private Sub UserForm_Resize()
    If mclsResizer Is Nothing Then Exit Sub
    mclsResizer.FormResize
End Sub
'----------------------METHODS----------------------

Public Sub Initialise()
'-------------------------------------------------------------------------
' Procedure : Initialise
' Company   : JKP Application Development Services (c)
' Author    : Jan Karel Pieterse (www.jkp-ads.com)
' Created   : 14-5-2008
' Purpose   : Initialises the form and makes sure the listbox resizes according to the data
'-------------------------------------------------------------------------
    Dim lRowCt As Long
    Dim lColCt As Long
    Dim lLengths() As Long

    On Error GoTo LocErr
    On Error GoTo LocErr
    ReDim lLengths(UBound(mvTable, 2))
    With lbxTable
        .Clear
        .ColumnCount = UBound(mvTable, 2) + 1
        For lRowCt = LBound(mvTable, 1) To UBound(mvTable, 1)
            For lColCt = LBound(mvTable, 2) To UBound(mvTable, 2)
                'Store the largest string length of each column of the array
                lLengths(lColCt) = Application.Max(lLengths(lColCt), Len(mvTable(lRowCt, lColCt)))
                If lColCt = LBound(mvTable, 2) Then
                    'first item has to be added through additem
                    .AddItem mvTable(lRowCt, lColCt)
                Else
                    .List(.ListCount - 1, lColCt - 1) = CStr(mvTable(lRowCt, lColCt))
                End If
            Next
        Next
    End With
    If AutoColWidths Then
        'Now autosize the ColumnWidths
        SetWidths lLengths()
    End If

    'Create the instance of the form resizer class
    Set mclsResizer = New CFormResizer
    'Tell it where to store the form dimensions
    mclsResizer.RegistryKey = GSREGKEY
    'Tell it which form it's handling
    Set mclsResizer.Form = Me

    'Temporarily disable adjusting lbxtable, it has been sized already
    lbxTable.Tag = ""

    'Adjust dimensions of form using new dimensions of the listbox
    'The form_resize event handles the positioning of the other controls on the form
    Me.Width = lbxTable.Left + lbxTable.Width + 12
    Me.Height = lbxTable.Top + lbxTable.Height + 30 + cmbClose.Height

    'Enable size of listbox again
    lbxTable.Tag = "WH"
TidyUp:
    On Error GoTo 0
    Exit Sub
LocErr:
    Select Case ReportError(Err.Description, Err.Number, "Initialise", "Form ufShowTable")
    Case vbRetry
        Resume
    Case vbIgnore
        Resume Next
    Case vbAbort
        Resume TidyUp
    End Select
End Sub

Private Function SetWidths(lLengths() As Long)
'-------------------------------------------------------------------------
' Procedure : SetWidths
' Company   : JKP Application Development Services (c)
' Author    : Jan Karel Pieterse (www.jkp-ads.com)
' Created   : 14-5-2008
' Purpose   : Sets the column widths of the listbox according to an array of max text lengths
'-------------------------------------------------------------------------
    Dim lCt As Long
    Dim sWidths As String
    Dim dTotWidth As Double
    On Error GoTo LocErr
    For lCt = 1 To UBound(lLengths)
        With lblHidden
            'Using repeating letter m to determine width because that is a relatively wide letter.
            'To ensure text always fits, use capital M instead
            .Caption = String(lLengths(lCt), "m")
        End With
        dTotWidth = dTotWidth + lblHidden.Width
        If Len(sWidths) = 0 Then
            sWidths = CStr(Int(lblHidden.Width) + 1)
        Else
            sWidths = sWidths & ";" & CStr(Int(lblHidden.Width) + 1)
        End If
    Next

    'Now set the widths of the columns
    lbxTable.ColumnWidths = sWidths

    'Adjust the dimensions of the listbox itself. You may want to adjust the constants
    'I hard coded here.

    'Listbox will always be at least 200 wide
    lbxTable.Width = Application.Min(Application.Max(200, dTotWidth + 12), lbxTable.Width)

    'Listbox will always be at least 48 high.
    lbxTable.Height = Application.Min(Application.Max((lbxTable.ListCount + 1) * 12, 48), lbxTable.Height)
TidyUp:
    On Error GoTo 0
    Exit Function
LocErr:
    Select Case ReportError(Err.Description, Err.Number, "SetWidths", "Form ufShowTable")
    Case vbRetry
        Resume
    Case vbIgnore
        Resume Next
    Case vbAbort
        Resume TidyUp
    End Select
End Function

'----------------------PROPERTIES----------------------
Public Property Get Table() As Variant
    Table = mvTable
End Property

Public Property Let Table(ByVal vTable As Variant)
    mvTable = vTable
End Property

Public Property Let Title(ByVal sTitle As String)
    lblTableTitle.Caption = sTitle
End Property

Public Property Get AutoColWidths() As Boolean
    AutoColWidths = mbAutoColWidths
End Property

Public Property Let AutoColWidths(ByVal bAutoColWidths As Boolean)
    mbAutoColWidths = bAutoColWidths
End Property

Public Property Get FormWidth() As Double
    FormWidth = Me.Width
End Property

Public Property Let FormWidth(ByVal dFormWidth As Double)
    Me.Width = dFormWidth
End Property

Public Property Get FormHeight() As Double
    FormHeight = Me.Height
End Property

Public Property Let FormHeight(ByVal dFormHeight As Double)
    Me.Height = dFormHeight
End Property

The attentive reader will have spotted that I hard-coded some constants into the code. Of course if you develop this thing for yourself, you'd have used constants or some other way to control (for example) the maximum column widths.