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
Related