listview VBA中的鼠标悬停

listview VBA中的鼠标悬停,vba,listview,Vba,Listview,我想通过鼠标悬停而不是单击来选择listitem。。如何在vba中实现 我在一个论坛上看到一个使用vb.net的代码 Private Sub ListView1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListView1.MouseMove Dim itm As ListViewItem itm = Me.ListView1.GetItemA

我想通过鼠标悬停而不是单击来选择listitem。。如何在vba中实现

我在一个论坛上看到一个使用vb.net的代码

Private Sub ListView1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListView1.MouseMove
    Dim itm As ListViewItem
    itm = Me.ListView1.GetItemAt(e.X, e.Y)
    If Not itm Is Nothing Then
        MessageBox.Show(itm.Text)
    End If
    itm = Nothing
End Sub
我也有这个。。但这不适用于其他行项目。。始终选择第一项

Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    Dim itm As ListItem
    Me.ListView1.MultiSelect = False
    
    Set itm = Me.ListView1.HitTest(x, y)
    If Not itm Is Nothing Then
        itm.Selected = True
    End If
End Sub

正如我在评论中所说,这是Excel单元“提供”的(像素)和列表视图需要的(twips)之间的转换问题。工作解决方案将是下一个:

  • 请复制表单代码模块顶部的下一个API函数(在声明区域中):
  • 使用下一个修改的事件:
  • 也复制下一个函数:
  • 我不是上述职能的“父亲”。几年前,我在互联网上找到了这些基地。我记得我修改了一些东西,但我不记得是什么


    请尝试建议的解决方案并发送一些反馈。

    这是Excel提供的(像素)和列表视图要求(twips)之间的必要转换问题。我还尝试了类似的方法,我必须创建一个转换函数。几分钟后,我会试着记住我所做的事情并发布一个答案。
    Option Explicit
    
    Private Declare PtrSafe Function GetDC Lib "user32" _
                               (ByVal hwnd As Long) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _
                (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" _
                            (ByVal hwnd As Long, ByVal hDC As Long) As Long
    
    Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                    ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
      Dim itm As MSComctlLib.ListItem
        Me.ListView1.SelectedItem.Selected = False ' unselect a previous selected subitem
        
        ConvertPixelsToTwips x, y         'make the necessary units conversion
        Set itm = ListView1.HitTest(x, y) 'set the object using the converted coordinates
        If Not itm Is Nothing Then
            itm.Selected = True
        End If
    End Sub
    
    Private Sub ConvertPixelsToTwips(ByRef x As stdole.OLE_XPOS_PIXELS, _
                                         ByRef y As stdole.OLE_YPOS_PIXELS)
        Dim hDC As Long, RetVal As Long, TwipsPerPixelX As Long, TwipsPerPixelY As Long
        Const LOGPIXELSX = 88
        Const LOGPIXELSY = 90
        Const TWIPSPERINCH = 1440
     
        hDC = GetDC(0)
        TwipsPerPixelX = TWIPSPERINCH / GetDeviceCaps(hDC, LOGPIXELSX)
        TwipsPerPixelY = TWIPSPERINCH / GetDeviceCaps(hDC, LOGPIXELSY)
        RetVal = ReleaseDC(0, hDC)
        x = x * TwipsPerPixelX:  y = y * TwipsPerPixelY    
    End Sub