【新提醒】VBA之Listbox控件基础教程

2.3、Listbox如何显示“标题”

要是Listbox中的列很多，用户就很难搞清楚该列到底是什么数据，这时还得有必要加个标题。上面说了，使用了List属性，就没法使用标题了，只能用标签在窗体上标注出来，或者在列表的第一行显示标题。用标签的方式很简单，用鼠标拖几个标签即可，我说说在列表的第一行显示标题的方法。
为了在第一行插入标题，得注意两个问题，一个是不能单击选中它，另一个是双击输出的时候得判断是不是第一行。还需要注意的是如果Listbox控件中已有数据，是不可以再使用List属性一次性赋值的，这就需要在用List赋值后使用AddItem( , -1)在第一行数据之前插入标题。代码修改如下：
Private arr '存放数据的数组
Private brr '存放标题的数组
Private Sub ListBox1_Click()
    With ListBox1
        If .ListIndex = 0 Then .ListIndex = - 1
    End With
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i&
    With ListBox1
        i = .TopIndex + Y \ .Font.Size
        If i < .ListCount Then .ListIndex =i
    End With
End Sub

Private Sub TextBox1_Change()
    Dim i&, j&, k&
    With ListBox1
        .Clear
        .AddItem '添加标题
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
        For i = 1 To UBound(arr) '多条件模糊查询，只需把各列串联起来即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一个空行，行号、列号都从0开始算
                k = k + 1 '记录行号
                For j = 1 To UBound(arr, 2)
                    .List(k, j - 1) = arr(i, j)
                Next
            End If
        Next
    End With
End Sub

Private Sub UserForm_Initialize()
    arr = Range("a2:L" & Range("a" & Rows.Count).End(xlUp).Row)
    brr = Range("a1:L1")
    With ListBox1
        .Font.Size = 10
        .ForeColor = vbBlue
        .ColumnCount = 12
        .ColumnWidths = "0;80;100;100,100,60;60,60,100,0,0,0"
        .List = arr '一次性赋值给Listbox控件。不能先AddItem，否则出错
        .AddItem , -1 '在第一行之前添加标题
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
    End With
End Sub
注意，MouseMove中的代码是让鼠标滑过时，让鼠标所在行高亮的代码TopIndex是列表中可见的第一行索引，Y\Font.Size是偏移量，因为鼠标光标的坐标(X,Y)和字体大小的单位都是磅，“\”是取整运算符，Y\Font.Size的结果就是偏移可见区首行的偏移量（字体大小约等于行高），两者之和大致是鼠标光标所在行索引。这个方法计算出来的仅仅是大概值，光标所在行偏离首行越远就越不准，在行数较少时是没有问题的。

2.4、Listbox支持鼠标滚动键

因为Listbox历史悠久，是不支持鼠标滚动键的（那时的鼠标应该还没有滚动键），有些人可能会觉得使用诸多不便。其实有一个简单的方法可用，即先选中一行数据，然后按住鼠标左键，上下拖动鼠标，就可以上下翻滚数据行了。是不是很简单，有种想说一句“So Easy！哪里不会点哪里”的冲动？
如果还是想要“正宗”的鼠标滚动键，还是有办法的，就有非常纠结的网友查阅各种洋文资料，搅鼓出了鼠标钩子的代码，试用了下，挺可以的，原贴地址：http://club./thread-1259440-1-1.html，感谢分享，模块中的代码如下：

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)

Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201

Private mLngMouseHook As Long
Private mListBoxHwnd As Long
Private mbHook As Boolean
Public LISTBOX_Post_Flag As Integer
Public LISTBOX_Mouse_Flag As Integer

Sub HookListBoxScroll()
    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Dim tPT As POINTAPI
    GetCursorPos tPT
    hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
    If mListBoxHwnd <> hwndUnderCursor Then
        UnhookListBoxScroll
        mListBoxHwnd = hwndUnderCursor
        lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
        PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
        End If
    End If
End Sub

Sub UnhookListBoxScroll()
    If mbHook Then
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mListBoxHwnd = 0
        mbHook = False
    End If
End Sub

Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long
    On Error GoTo errH
    If (nCode = HC_ACTION) Then
        If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then
            If wParam = WM_MOUSEWHEEL Then
                MouseProc = True
                If lParam.hwnd > 0 Then
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 1 Then frm.ListBox1.TopIndex = frm.ListBox1.TopIndex - 1
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 2 Then PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
                Else
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 1 Then frm.ListBox1.TopIndex = frm.ListBox1.TopIndex + 1
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 2 Then PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
                End If
                PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                Exit Function
            End If
        Else
            UnhookListBoxScroll
        End If
    End If
    MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
    Exit Function
errH:
    UnhookListBoxScroll
End Function

窗体中的代码如下：

Private arr '存放数据的数组
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookListBoxScroll
End Sub

Private Sub OptionButton1_Click()
    LISTBOX_Mouse_Flag = 1
End Sub

Private Sub OptionButton2_Click()
    LISTBOX_Mouse_Flag = 2
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    UnhookListBoxScroll
End Sub

Private Sub TextBox1_Change()
    Dim i&, j&, k&
    With ListBox1
        .Clear
        For i = 1 To UBound(arr) '多条件模糊查询，只需把各列串联起来即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一个空行，行号、列号都从0开始算
                For j = 1 To UBound(arr, 2)
                    .List(k, j - 1) = arr(i, j)
                Next
                k = k + 1 '记录行号
            End If
        Next
    End With
End Sub

Private Sub UserForm_Initialize()
    LISTBOX_Post_Flag = 1
    LISTBOX_Mouse_Flag = 1
    OptionButton1 = True
    arr = Range("a2:L" & Range("a" & Rows.Count).End(xlUp).Row)
    With ListBox1
        .Font.Size = 10
        .ForeColor = vbBlue
        .ColumnCount = 12
        .ColumnWidths = "0;80;100;100,100,60;60,60,100,0,0,0"
        .List = arr
    End With
End Sub

经过试验，在工作表中的Listbox控件（ActiveX）也可使用这个钩子。工作表的Listbox控件也有ListBox1_MouseMove事件，可在该事件中直接调用：HookListBoxScroll。工作表中没有UserForm_QueryClose，可以在控件失焦事件ListBox1_LostFocus()中调用UnhookListBoxScroll即可。




补充内容 (2020-12-6 19:56):
在工作表中让Listbox支持鼠标滚动键，可见141楼：http://club./thread-1451605-15-1.html