中文字幕理论片,69视频免费在线观看,亚洲成人app,国产1级毛片,刘涛最大尺度戏视频,欧美亚洲美女视频,2021韩国美女仙女屋vip视频

2.3、Listbox如何顯示“標(biāo)題”

要是Listbox中的列很多，用戶就很難搞清楚該列到底是什么數(shù)據(jù)，這時(shí)還得有必要加個(gè)標(biāo)題。上面說了，使用了List屬性，就沒法使用標(biāo)題了，只能用標(biāo)簽在窗體上標(biāo)注出來，或者在列表的第一行顯示標(biāo)題。用標(biāo)簽的方式很簡單，用鼠標(biāo)拖幾個(gè)標(biāo)簽即可，我說說在列表的第一行顯示標(biāo)題的方法。
為了在第一行插入標(biāo)題，得注意兩個(gè)問題，一個(gè)是不能單擊選中它，另一個(gè)是雙擊輸出的時(shí)候得判斷是不是第一行。還需要注意的是如果Listbox控件中已有數(shù)據(jù)，是不可以再使用List屬性一次性賦值的，這就需要在用List賦值后使用AddItem( , -1)在第一行數(shù)據(jù)之前插入標(biāo)題。代碼修改如下：
Private arr '存放數(shù)據(jù)的數(shù)組
Private brr '存放標(biāo)題的數(shù)組
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 '添加標(biāo)題
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
        For i = 1 To UBound(arr) '多條件模糊查詢，只需把各列串聯(lián)起來即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一個(gè)空行，行號、列號都從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，否則出錯(cuò)
        .AddItem , -1 '在第一行之前添加標(biāo)題
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
    End With
End Sub
注意，MouseMove中的代碼是讓鼠標(biāo)滑過時(shí)，讓鼠標(biāo)所在行高亮的代碼TopIndex是列表中可見的第一行索引，Y\Font.Size是偏移量，因?yàn)槭髽?biāo)光標(biāo)的坐標(biāo)(X,Y)和字體大小的單位都是磅，“\”是取整運(yùn)算符，Y\Font.Size的結(jié)果就是偏移可見區(qū)首行的偏移量（字體大小約等于行高），兩者之和大致是鼠標(biāo)光標(biāo)所在行索引。這個(gè)方法計(jì)算出來的僅僅是大概值，光標(biāo)所在行偏離首行越遠(yuǎn)就越不準(zhǔn)，在行數(shù)較少時(shí)是沒有問題的。

2.4、Listbox支持鼠標(biāo)滾動鍵

因?yàn)長istbox歷史悠久，是不支持鼠標(biāo)滾動鍵的（那時(shí)的鼠標(biāo)應(yīng)該還沒有滾動鍵），有些人可能會覺得使用諸多不便。其實(shí)有一個(gè)簡單的方法可用，即先選中一行數(shù)據(jù)，然后按住鼠標(biāo)左鍵，上下拖動鼠標(biāo)，就可以上下翻滾數(shù)據(jù)行了。是不是很簡單，有種想說一句“So Easy！哪里不會點(diǎn)哪里”的沖動？
如果還是想要“正宗”的鼠標(biāo)滾動鍵，還是有辦法的，就有非常糾結(jié)的網(wǎng)友查閱各種洋文資料，攪鼓出了鼠標(biāo)鉤子的代碼，試用了下，挺可以的，原貼地址：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 '存放數(shù)據(jù)的數(shù)組
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) '多條件模糊查詢，只需把各列串聯(lián)起來即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一個(gè)空行，行號、列號都從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

經(jīng)過試驗(yàn)，在工作表中的Listbox控件（ActiveX）也可使用這個(gè)鉤子。工作表的Listbox控件也有ListBox1_MouseMove事件，可在該事件中直接調(diào)用：HookListBoxScroll。工作表中沒有UserForm_QueryClose，可以在控件失焦事件ListBox1_LostFocus()中調(diào)用UnhookListBoxScroll即可。




補(bǔ)充內(nèi)容 (2020-12-6 19:56):
在工作表中讓Listbox支持鼠標(biāo)滾動鍵，可見141樓：http://club.excelhome.net/thread-1451605-15-1.html