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