Excel VBA ListView Headers Bold

Question

I am new to VBA and struggling to make my ListView (named "lvRec") headers bold only.

The ListView is in a userform, Excel populated from the currect workbook, "MySales" table. How to format headers, please?

Private Sub UserForm_Activate()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim lv As ListItem
    Dim i As Integer, n As Integer

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set tbl = ws.ListObjects("MySales")

    With Me.lvRec
        .Gridlines = True
        .HoverSelection = True
        .View = lvwReport
    
    End With
    
    
    'Add column headers
    For i = 1 To tbl.ListColumns.Count
        Me.lvRec.ColumnHeaders.Add , , tbl.ListColumns(i).Name

    Next i

    
    With tbl.Range
        For i = 2 To .Rows.Count
            Set lv = Me.lvRec.ListItems.Add(, , tbl.Range.Cells(i, 1).Text)
            For n = 2 To .Columns.Count
                lv.ListSubItems.Add , , tbl.Range.Cells(i, n).Text
            Next n
        Next i
    End With


End Sub

I have searched online, but couldn't apply what I have found. They mentioned "Font" property, but i couldn't call it for headers.

Answer 1

You cannot use the ColumnHeaders.Font property. It will not work. You will have to use APIs (SendMessage, GetWindow, SendMessageByString and CreateFontIndirect) to achieve what you want.

Is this what you are trying?

You can change the font and the font size in CreateFont("Arial", 20, True)

Option Explicit

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function GetWindow Lib "user32" _
(ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr

Private Declare PtrSafe Function SendMessageByString Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam _
As LongPtr, ByVal lParam As String) As LongPtr

Private Declare PtrSafe Function CreateFontIndirect Lib _
"gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPtr

Private Const LVM_GETHEADER = &H101F

Private Const WM_SETFONT = &H30

Private Type HDITEM
    mask As Long
    cxy As Long
    pszText As String
    hbm As LongPtr
    cchTextMax As Long
    fmt As Long
    lParam As LongPtr
    iImage As Long
    iOrder As Long
    type As Byte
    cxyBitmap As Long
    hbmDiscarded As LongPtr
End Type

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 32
End Type

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim lv As ListItem
    Dim i As Integer, n As Integer

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set tbl = ws.ListObjects("MySales")

    With Me.lvRec
        .Gridlines = True
        .HoverSelection = True
        .View = lvwReport
    End With
    
    '~~> Add column headers
    For i = 1 To tbl.ListColumns.Count
        Me.lvRec.ColumnHeaders.Add , , tbl.ListColumns(i).Name
    Next i
    
    With tbl.Range
        For i = 2 To .Rows.Count
            Set lv = Me.lvRec.ListItems.Add(, , tbl.Range.Cells(i, 1).Text)
            For n = 2 To .Columns.Count
                lv.ListSubItems.Add , , tbl.Range.Cells(i, n).Text
            Next n
        Next i
    End With

    Dim hHeader As LongPtr
    Dim hFont As LongPtr
    Dim item As HDITEM
    
    '~~> Get the handle of the header control
    hHeader = GetHeaderHandle(Me.lvRec)
    
    '~~> Create a new font
    '~~> Change Font and Font Size accordingly
    hFont = CreateFont("Arial", 20, True)
    
    '~~> Set the font for the header control
    SendMessage hHeader, WM_SETFONT, hFont, True
    
    '~~> Update the ListView
    Me.lvRec.Refresh
End Sub

Private Function GetHeaderHandle(lstVw As listView) As LongPtr
    '~~> Returns the handle of the header control of the given ListView
    Dim lvHwnd As LongPtr
    Dim headerHwnd As LongPtr
    
    '~~> Get the handle of the ListView
    lvHwnd = lstVw.hWnd
    
    '~~> Get the handle of the header control
    headerHwnd = SendMessage(lvHwnd, LVM_GETHEADER, 0, 0)
    
    GetHeaderHandle = headerHwnd
End Function

Private Function CreateFont(fontName As String, fontSize As Long, bold As Boolean) As LongPtr
    '~~> Creates a font with the specified attributes and returns its handle
    Dim lf As LOGFONT
    Dim fontHandle As LongPtr
    
    lf.lfHeight = fontSize
    lf.lfWeight = IIf(bold, 700, 400)
    lf.lfCharSet = 0
    lf.lfClipPrecision = 0
    lf.lfEscapement = 0
    lf.lfItalic = False
    lf.lfOrientation = 0
    lf.lfOutPrecision = 0
    lf.lfPitchAndFamily = 0
    lf.lfQuality = 0
    lf.lfStrikeOut = False
    lf.lfUnderline = False
    lf.lfWidth = 0
    lf.lfFaceName = fontName & Chr(0)
    
    fontHandle = CreateFontIndirect(lf)
    
    CreateFont = fontHandle
End Function

Screenshot