如何VB实现鼠标指向单元格提示信息

a6789

原帖由 liguyu 于 2010-4-28 11:42 发表
我弄明白了,原来先要通过"控件工具箱"拖一个标签控件出来,再运行.

请问如何做?

zhengzhouwu

你好  
能不能告诉下不“单击”，而只是移动鼠标就可以显示提示该怎么写代码。

HHAAMM

移动鼠标就显示，要用Api函数时实返回鼠标位置，再那个什么属性检测鼠标当前位置是不是单元格，很浪费系统资源的不可取

zhengzhouwu

版主，像EXCEL里的批注那种效果用VBA怎么写的出来啊。鼠标到那个单元格就显示，鼠标移走就没有了。我从网上找了些用API函数返回鼠标的，但会不断的刷新，无法达到EXCEL 里的批注那种效果。

HHAAMM

原帖由 zhengzhouwu 于 2011-5-24 22:59 发表
版主，像EXCEL里的批注那种效果用VBA怎么写的出来啊。鼠标到那个单元格就显示，鼠标移走就没有了。我从网上找了些用API函数返回鼠标的，但会不断的刷新，无法达到EXCEL 里的批注那种效果。

要是用批注，那所有相关单元格都要加上批注，似乎有些不可想象的

说的也是，要是能捕获批注相应鼠标的事件那问题真的就解决了

dhf104109

Excel中精确控制鼠标光标位置



前面的尺寸单位中介绍过Window对象的PointsToScreenPixelsX和PointsToScreenPixelsY方法，这两个方法对精确控制鼠标光标在Excel中的位置很有帮助。这个例子示范控制鼠标光标到指定的单元格或控件中心，并可模拟鼠标单击控件如按钮的功能，光标的位置是以像素为单位，而控件或单元格在Excel中的位置是以Point为单位，所以需要用到前面的换算自定义函数。

Public Type POINTAPI
x As Long
y As Long
End Type
' 设置鼠标光标位置
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
' 鼠标动作模拟
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Declare Sub mouse_event Lib "user32" ( _
ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
' 移动鼠标光标到指定的单元格中心，iRow和iCol分别为指定单元格行和列
Sub SetCursorToCell(iRow As Integer, iCol As Integer)
Dim pt As POINTAPI
Dim iTRow As Integer
Dim iTCol As Integer
' 当前窗口可见范围的总行数和列数
    iTRow = ActiveWindow.VisibleRange.Rows.Count
iTCol = ActiveWindow.VisibleRange.Columns.Count
' 如果指定单元格在可见范围之外，则选择该单元格让其在可见范围中显示
    If iRow < ActiveWindow.VisibleRange.Row Or iRow > ActiveWindow.VisibleRange.Row + iTRow - 1 Or _
iCol < ActiveWindow.VisibleRange.Column Or iCol > ActiveWindow.VisibleRange.Column + iTCol - 1 Then
Cells(iRow, iCol).Select
End If
' 指定单元格中心在屏幕坐标中X轴的位置，以像素为单位
    pt.x = ActiveWindow.PointsToScreenPixelsX(0) + _
Point2PixelX(Cells(iRow, iCol).Left + Cells(iRow, iCol).Width / 2)
' 指定单元格中心在屏幕坐标中Y轴的位置，以像素为单位
    pt.y = ActiveWindow.PointsToScreenPixelsY(0) + _
Point2PixelX(Cells(iRow, iCol).Top + Cells(iRow, iCol).Height / 2)
' 设置鼠标光标到指定位置
    SetCursorPos pt.x, pt.y
End Sub
' 移动鼠标光标到指定的控件中心，vControl为指定空间
Sub SetCursorToControl(vControl As Variant)
Dim pt As POINTAPI
' 如果控件显示在可见范围之外，选择控件覆盖的单元格使其可见
    With ActiveWindow.VisibleRange
If vControl.Left + vControl.Width > .Left + .Width Or vControl.Top + vControl.Height > .Top + .Height Then
vControl.BottomRightCell.Select
End If
If vControl.Left < .Left Or vControl.Top < .Top Then
vControl.TopLeftCell.Select
End If
End With
' 指定控件中心在屏幕中标中X轴的位置，以像素为单位
    pt.x = ActiveWindow.PointsToScreenPixelsX(0) + Point2PixelX(vControl.Left + vControl.Width / 2)
' 指定控件中心在屏幕中标中Y轴的位置，以像素为单位
    pt.y = ActiveWindow.PointsToScreenPixelsY(0) + Point2PixelY(vControl.Top + vControl.Height / 2)
' 设置鼠标光标到指定位置
    SetCursorPos pt.x, pt.y
End Sub
Sub ClickControl(iControl As Variant)
' 设置光标到指定控件
    SetCursorToControl iControl
' 模拟鼠标单击的动作
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0&, 0&
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0&, 0&
End Sub
' 移动鼠标光标到控件CommandButton1
Sub test1()
SetCursorToControl Sheet1.CommandButton1
End Sub
' 模拟单击控件CommandButton1
Sub test2()
ClickControl Sheet1.CommandButton1
End Sub
' 移动鼠标光标到单元格B2
Sub test3()
SetCursorToCell 2, 2
End Sub

另外Excel窗体是以屏幕坐标位置显示的，但单位仍然是Point，如果需要在指定位置显示窗体，例如在所选择的单元格右侧，同样要用到尺寸转换的自定义函数和Window对象的PointsToScreenPixelsX和PointsToScreenPixelsY方法。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 如果窗体UserForm1没有显示，则显示它
    If UserForm1.Visible = False Then
UserForm1.Show 0
End If
' 移动窗体到选择的单元格右侧位置
    UserForm1.Move Pixel2PointX(ActiveWindow.PointsToScreenPixelsX(0)) + Target.Left + Target.Width, _
Pixel2PointY(ActiveWindow.PointsToScreenPixelsY(0)) + Target.Top
End Sub

LXQ1225

复制代码

热浪2006

9楼老朽所言极是

sgmike

楼主能不能发一个带此宏的xls文件出来，我也需要{:soso_e112:}

AVEL

1. Option Explicit
   
2. 
   
3. Private Sub Worksheet_Activate()
   
4.     Dim arr, c As Range, r%, i%
   
5.     arr = Sheet2.[a1].CurrentRegion
   
6.     For Each c In Range("a2:a" & [a65536].End(3).Row)
   
7.         If Not c.Comment Is Nothing Then c.Comment.Delete
   
8.         For i = 2 To UBound(arr)
   
9.             If arr(i, 1) = c Then r = i
   
10.         Next
    
11.         c.AddComment.Text "性别:" & arr(r, 2) & Chr(10) & "出生年月日:" & arr(r, 3) & Chr(10) & "家庭地址:" & arr(r, 4) _
    
12.                           & Chr(10) & "家长:" & arr(r, 5) & Chr(10) & "家长电话:" & arr(r, 6)
    
13.         c.Comment.Shape.TextFrame.AutoSize = True
    
14.         With c.Comment.Shape   '美化批注
    
15.                 .TextFrame.AutoSize = True                   '自适应大小
    
16.                 .AutoShapeType = msoShapeRoundedRectangle    '圆角边框
    
17.                 .Line.ForeColor.SchemeColor = 53             '边框颜色
    
18.                 .Line.Weight = 1                             '边框粗细
    
19.                 .TextFrame.Characters.Font.ColorIndex = 5    '字体颜色
    
20.         End With
    
21.     Next
    
22. End Sub

复制代码