|
楼主 |
发表于 2018-12-14 22:17
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
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.excelhome.net/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.excelhome.net/thread-1451605-15-1.html |
评分
-
3
查看全部评分
-
|