列表视图中的鼠标悬停 VBA

Question

我想 select 通过悬停鼠标而不是单击来显示列表项.. 如何在 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

我也有这个..但是这不会转到其他行项目..总是select第一个项目。

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

Answer 1

正如我在评论中所说，这是 Excel 单位 'offers'（像素）与列表视图需要的单位（缇）之间的转换问题。工作解决方案将是下一个：

请复制表单代码模块顶部的下一个 API 函数（在声明区域）：

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

我不是上面函数的'father'。几年前，我在互联网上找到了基地。我记得我修改了一些东西，但我不记得是什么了...

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

列表视图中的鼠标悬停 VBA

Mousehover in listview VBA

vba

listview