Option Compare Database
Option Explicit

Private WithEvents tv As MSComctlLib.TreeView

Private Const TVS_CHECKBOXES As Long = &H100
Private Const GWL_STYLE As Long = (-16)
Private Const TVS_HASLINES As Long = 2
Private Const TV_FIRST As Long = &H1100
Private Const TVM_SETBKCOLOR As Long = (TV_FIRST + 29)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
     
Private Sub SetTVCheckboxStyle(pobjTV As TreeView)

    Dim lngCurStyle As Long
    Dim lngResult   As Long

    ' === Set the Checkbox style of the TreeView ===
    ' As advised by Microsoft, due to a bug in the TreeView control,
    ' set the Checkbox style of the TreeView by using the following
    ' API calls, rather than simply setting the "Checkboxes" property
    ' to True ...
    lngCurStyle = GetWindowLong(pobjTV.hwnd, GWL_STYLE)
    lngResult = SetWindowLong(pobjTV.hwnd, GWL_STYLE, _
                              lngCurStyle Or TVS_CHECKBOXES)

End Sub

Private Sub Form_Load()
    Dim tvnTemp As Object
    
    Set tv = TreeView0.Object
    
    SetTVCheckboxStyle tv
    
    Set tvnTemp = tv.Nodes.Add(, , "n1", "1")
    tvnTemp.Expanded = True
    Set tvnTemp = tv.Nodes.Add(, , "n2", "2")
    tvnTemp.Expanded = True
    
    Set tvnTemp = tv.Nodes.Add("n1", 4, "n1.1", "1.1")
    Set tvnTemp = tv.Nodes.Add("n1", 4, "n1.2", "1.2")
    Set tvnTemp = tv.Nodes.Add("n1", 4, "n1.3", "1.3")
    
    Set tvnTemp = tv.Nodes.Add("n2", 4, "n2.1", "2.1")
    Set tvnTemp = tv.Nodes.Add("n2", 4, "n2.2", "2.2")
    Set tvnTemp = tv.Nodes.Add("n2", 4, "n2.3", "2.3")
    
End Sub

Private Sub tv_NodeClick(ByVal Node As MSComctlLib.Node)
    If Node.Key Like "n1.*" Then
        Node.Checked = False
    End If
End Sub