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

a6789 · 发表于 2010-5-2 00:52

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

请问如何做?

zhengzhouwu · 发表于 2011-5-24 20:36

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

HHAAMM · 发表于 2011-5-24 21:09

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

zhengzhouwu · 发表于 2011-5-24 22:59

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

HHAAMM · 发表于 2011-5-24 23:39

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

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

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

dhf104109 · 发表于 2011-5-25 18:52

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 · 发表于 2011-10-28 18:43

本帖最后由 LXQ1225 于 2011-10-28 18:44 编辑

复制代码

热浪2006 · 发表于 2011-10-28 19:22

9楼老朽所言极是

sgmike · 发表于 2011-10-28 18:23

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

AVEL · 发表于 2011-10-28 18:46

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

复制代码

		自动登录	找回密码
密码			免费注册

[已解决] 如何VB实现鼠标指向单元格提示信息

回复 2楼 maditate 的帖子

不知高手们能否从这里得到一些启发，我是看不懂