ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 11183|回复: 11

[求助] 在word中,用vba如何得到当前鼠标的位置

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-6-2 11:36 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
项目中有个需求,要在word中鼠标所在的当前位置插入文本框(不是光标位置),但是我不知道怎么才能得到这个坐标,所以请大家指点一下在vba中如何得到当前鼠标的位置。
先谢谢了!

TA的精华主题

TA的得分主题

发表于 2014-6-3 07:25 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
这个是可以获得光标的所在位置的
  1. Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

  2. Type POINTAPI
  3.     X As Long
  4.     Y As Long
  5. End Type

  6. Public Function getmouse_x_y() As POINTAPI
  7. GetCursorPos getmouse_x_y

  8. End Function

  9. Sub test()
  10. 'call getmouse_x_y '调用“获取鼠标坐标值过程”(假定你们给的过程/程序,名叫getmouse_x_y)

  11. Dim ss As Long

  12. ss = getmouse_x_y.X
  13. Debug.Print ss


  14. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-6-3 14:27 | 显示全部楼层
十分感谢楼上的回复,这样可以获得鼠标的位置了,但还有个问题,通过GetCursorPos得到的位置是基于整个屏幕的,可我是想在word的页面里根据鼠标位置插入文本框(使用的方法是Shapes.AddTextbox),如何将基于屏幕的坐标和基于页面的坐标之间进行转换呢?
望再赐教啊,先谢了!

TA的精华主题

TA的得分主题

发表于 2014-6-3 15:23 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
liuyang7758258 发表于 2014-6-3 14:27
十分感谢楼上的回复,这样可以获得鼠标的位置了,但还有个问题,通过GetCursorPos得到的位置是基于整个屏幕 ...

试一试 吧  我都不肯定可以

  1. Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

  2. Type POINTAPI
  3.     X As Long
  4.     Y As Long
  5. End Type

  6. Public Function getmouse_x_y() As POINTAPI
  7.     GetCursorPos getmouse_x_y

  8. End Function

  9. Sub test()
  10. 'call getmouse_x_y '调用“获取鼠标坐标值过程”(假定你们给的过程/程序,名叫getmouse_x_y)

  11.     Dim ss As Long

  12.     Set oRange = ActiveWindow.RangeFromPoint(getmouse_x_y.X, getmouse_x_y.Y)
  13.    
  14.    
  15.     If Not oRange Is Nothing Then
  16.         X = oRange.Information(wdHorizontalPositionRelativeToPage)
  17.         Y = oRange.Information(wdVerticalPositionRelativeToPage)
  18.     End If



  19.     ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, X, Y, 50, 50).Visible = True

  20.     Debug.Print X, Y


  21. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-6-3 20:05 | 显示全部楼层
闻启学 发表于 2014-6-3 15:23
试一试 吧  我都不肯定可以

感谢,我试了一下,应该是不行,使用ActiveWindow.RangeFromPoint(x, y)返回一个object,无论设置屏幕坐标x和y是任何值,再使用Information获得的页面坐标值都是90和72,无法转换屏幕坐标到页面坐标。
大侠还有没有其他方法了?望再赐教啊!

TA的精华主题

TA的得分主题

发表于 2014-6-4 08:39 | 显示全部楼层
请查阅Selection.Information
WdInformation 枚举
名称 值 描述
wdActiveEndAdjustedPageNumber 1 返回页码,在该页中包含指定的所选内容或区域的活动结尾。如果设置一个起始页码或进行其他手动调整,则返回经调整的页码(与  wdActiveEndPageNumber 不同)。
wdActiveEndPageNumber 3 返回页码,在该页中包含指定的所选内容或区域的活动结尾。从文档开头计数。忽略任何对页码的手动调整(与  wdActiveEndAdjustedPageNumber 不同)。
wdActiveEndSectionNumber 2 返回节号,在该节中包含了指定的所选内容或区域的活动结尾。
wdAtEndOfRowMarker 31 如果指定的所选内容或区域位于表格的行结尾标记处,则该参数返回 True。
wdCapsLock 21 如果 Caps Lock 有效,则该参数返回 True。
wdEndOfRangeColumnNumber 17 返回表格列号,在该表格列中包含指定的所选内容或区域的结尾。
wdEndOfRangeRowNumber 14 返回表格行号,在该表格行中包含指定的所选内容或区域的结尾。
wdFirstCharacterColumnNumber 9 返回指定的所选内容或区域中第一个字符的位置。如果所选内容或区域是折叠的,则返回紧靠所选内容或区域右侧的字符编号(该编号与状态栏中“列”后面的字符列数相同)。
wdFirstCharacterLineNumber 10 返回指定的所选内容或区域中第一个字符的位置。如果所选内容或区域是折叠的,则返回紧靠所选内容或区域右侧的字符编号(该编号与状态栏中“行”后面的字符行数相同)。
wdFrameIsSelected 11 如果所选内容或区域是一个完整的图文框或文本框,则该参数返回 True。
wdHeaderFooterType 33 返回一个值,该值指示包含了指定所选内容或区域的页眉或页脚的类型。有关其他信息,请参阅“注解”部分中的表。
wdHorizontalPositionRelativeToPage 5 返回指定的所选内容或区域的水平位置。该位置是所选内容或区域的左边缘与页面的左边缘之间的距离,以磅为单位(1 磅 = 20 缇,72 磅 = 1 英寸)。如果所选内容或区域未显示在屏幕上,则该参数返回 -1。
wdHorizontalPositionRelativeToTextBoundary 7 返回指定所选内容或区域相对于周围最近的正文边界左边缘的水平位置,以磅为单位(1 磅 = 20 缇,72 磅 = 1 英寸)。如果所选内容或区域未显示在屏幕上,则该参数返回 -1。
wdInClipboard 38 有关该常量的信息,请参阅包含在 Microsoft Office Macintosh Edition 中的语言参考帮助。
wdInCommentPane 26 如果指定的所选内容或区域位于批注窗格,则该参数返回 True。
wdInEndnote 36 如果指定的所选内容或区域位于页面视图的尾注区内,或者位于普通视图的尾注窗格中,则该参数返回 True。
wdInFootnote 35 如果指定的所选内容或区域位于页面视图的脚注区内,或者位于普通视图的脚注窗格中,则该参数返回 True。
wdInFootnoteEndnotePane 25 如果指定的所选内容或区域位于普通视图的脚注或尾注窗格中,或页面视图的脚注或尾注区内,则该参数返回 True。有关详细信息,请参阅前面关于  wdInFootnote 和  wdInEndnote 的说明。
wdInHeaderFooter 28 如果指定的所选内容或区域位于页眉或页脚窗格中,或者位于页面视图的页眉或页脚中,则该参数返回 True。  
wdInMasterDocument 34 如果所选内容或区域位于主控文档(即至少包含一个子文档的文档)中,则该参数返回 True。
wdInWordMail 37 如果指定的所选内容或区域位于页眉或页脚窗格中,或者位于页面视图的页眉或页脚中,则该参数返回 True。
wdMaximumNumberOfColumns 18 返回所选内容或区域中任何行的最大表格列数。
wdMaximumNumberOfRows 15 返回指定的所选内容或区域中表格的最大行数。
wdNumberOfPagesInDocument 4 返回与所选内容或区域相关联的文档的页数。
wdNumLock 22 如果 Num Lock 有效,则该参数返回 True。  
wdOverType 23 如果启用改写模式,则该参数返回 True。可使用 Overtype 属性改变改写模式的状态。
wdReferenceOfType 32 返回一个值,该值表明所选内容相对于脚注、尾注或批注引用的位置,如“注解”部分中的表所示。
wdRevisionMarking 24 如果打开修订功能,则该参数返回 True。
wdSelectionMode 20 返回一个值,该值表明当前的选定模式,如下表所示。
wdStartOfRangeColumnNumber 16 返回表格列号,在该表格列中包含所选内容或区域的起点。
wdStartOfRangeRowNumber 13 返回表格行号,在该表格行中包含所选内容或区域的起点。
wdVerticalPositionRelativeToPage 6 返回所选内容或区域的垂直位置,即所选内容的上边缘与页面的上边缘之间的距离,以磅为单位(1 磅 = 20 缇,72 磅 = 1 英寸)。如果所选内容未显示在文档窗口中,则该参数返回 -1。
wdVerticalPositionRelativeToTextBoundary 8 返回所选内容或区域相对于周围最近的正文边界的上边缘的垂直位置,以磅为单位(1 磅 = 20 缇,72 磅 = 1 英寸)。该参数可用于在图文框或表格中确定插入点位置。如果所选内容未显示在屏幕中,则该参数返回 -1。
wdWithInTable 12 如果所选内容位于表格中,则该参数返回 True。  
wdZoomPercentage 19 返回由  Percentage 属性设置的当前的放大百分比。

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-6-4 09:10 | 显示全部楼层
loquat 发表于 2014-6-4 08:39
请查阅Selection.Information
WdInformation 枚举
名称 值 描述

感谢您的回复,从Selection.Information的描述看,使用wdHorizontalPositionRelativeToPage和wdVerticalPositionRelativeToPage是没错的,我也尝试了wdHorizontalPositionRelativeToTextBoundary和wdVerticalPositionRelativeToTextBoundary,还是无法正确的将屏幕坐标转换成页面坐标。
望给与进一步指导啊,多谢!

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-6-5 14:36 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
我已写代码实现了此功能,还是要感谢楼上的各位给出的回复!
主要思路是先获得鼠标在屏幕坐标下的位置信息,在通过自己的转化,将位置信息从屏幕坐标系转到页面坐标下,转化代码如下:

'得到鼠标的屏幕坐标
Dim sx As Long
Dim sy As Long
sx = getmouse_x_y.X
sy = getmouse_x_y.Y

Dim pLeft As Long
Dim pTop As Long
Dim pWidth As Long
Dim pHeight As Long

'得到屏幕坐标系下页面左顶点和右顶点的位置
Dim shapestar As Word.shape
Set shapestar = ActiveDocument.Shapes.AddShape(msoShape5pointStar, _
            0, 0, 0, 0)
ActiveDocument.ActiveWindow.GetPoint pLeft, pTop, _
        pWidth, pHeight, shapestar
shapestar.Delete

'得到当前页面放大比率
Dim sZoom As Single
sZoom = ActiveDocument.ActiveWindow.View.Zoom.Percentage / 100

'转化鼠标位置,从屏幕坐标系转到页面坐标系
Dim pleftdis As Long
Dim ptopdis As Long
Dim ptextboxleft As Long
Dim ptextboxtop As Long
ptextboxleft = 0
ptextboxtop = 0

pleftdis = sx - pLeft
ptopdis = sy - pTop

If pleftdis > 0 Then
    ptextboxleft = pleftdis / 1.333 / sZoom
End If
If ptopdis > 0 Then
    ptextboxtop = ptopdis / 1.333 / sZoom
End If
'ptextboxleft、ptextboxtop为得到的相应页面坐标
'在页面相应位置插入文本框

TA的精华主题

TA的得分主题

发表于 2014-6-6 20:37 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
看得出楼主花了不少功夫,不知道楼主的代码稳定性如何,有空测试一下。据我所知windows api中有一个客户窗口坐标和屏幕坐标转换的函数,可以实现楼主的要求

TA的精华主题

TA的得分主题

发表于 2014-6-8 17:53 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
学习学习了哦            
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-4-20 06:14 , Processed in 0.042538 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表