RenderListControlHeadings

RenderListControlHeadings

RenderListControlHeadings

Public Sub RenderListControlHeadings( _
    ListControl As Control, _
    ColumnHeadingString As String, _
    Optional FontWeight As Long = 400, _
    Optional OffsetLeft As Long = 8 _
)
    Dim ctls As Controls
    Dim iCtl As Control
    Dim strControlNameStub As String
    Dim strLabelNameStub As String
    Set ctls = ListControl.Parent.Controls
    strLabelNameStub = "lbheading_"
    strControlNameStub = _
        strLabelNameStub & _
        ListControl.Name
    Set ctls = ListControl.Parent.Controls
    For Each iCtl In ctls
        If Left( _
            iCtl.Name, _
            Len( _
                strControlNameStub _
            ) _
        ) = strControlNameStub Then
            ctls.Remove iCtl.Name
        End If
    Next iCtl
    If ColumnHeadingString = "" Then Exit Sub
    Dim arrWidths As Variant
    Dim arrHeadings As Variant
    arrWidths = Split( _
        ListControl.ColumnWidths, _
        ";" _
    )
    arrHeadings = Split( _
        ColumnHeadingString, _
        ";" _
    )
    Dim i As Integer
    Dim accLeftPosition As Long
    accLeftPosition = ListControl.Left + OffsetLeft
    For i = 0 To UBound(arrHeadings)
        With ctls.Add( _
            "Forms.Label.1", _
            strControlNameStub & i _
        )
            .Caption = arrHeadings(i)
            .Left = accLeftPosition
            .Top = ListControl.Top - 12
            .Font.Size = 7
            .Font.Weight = FontWeight
            .BackStyle = fmBackStyleTransparent
        End With
        accLeftPosition = _
            accLeftPosition + _
            CLng( _
                Trim( _
                    Replace( _
                        arrWidths(i), _
                        " pt", "" _
                    ) _
                ) _
            )
    Next i
End Sub

Leave a Reply

Your email address will not be published.