“API函数GetCursorPos 与Shape对象应用”总是听到或看到有人问，编程好学吗？如何入门？多久能学会？它能做些什么？怎么写代码呀?执行过程中出问题了谁能帮帮我...如果你也有类似的问题那就赶快关注我的公众号，一起学起来吧！
大家有没有遇到过这类问题：当处理包含大量行、列或复杂公式的报表时，默认的视图可能使字体显得过小，难以辨认。而且长时间盯着屏幕上的小字处理数据，极易导致视觉疲劳和注意力下降
又比如在会议中将Excel表格投屏展示，为了让观众（尤其是后排的观众）能清楚看到屏幕上的数据，通常需要将表格内容放大
接下来就通过一则案例，分享如何给Excel装上“放大镜”，让单元格内文字变大变清晰
1 效果展示
亮点介绍：
2.1 操作步骤
- 选择 “插入” -> “模块”，将文中全部代码复制粘贴到新模块中
- 回到Excel工作表界面，顺次选择【开发工具】【宏】，选择“MainPro”，按执行
以上步骤执行后，我们在查看报表数据时，就可以通过鼠标拖拽来查看放大后的数据了
2.2 代码实现
核心思路：创建并复用单个Shape对象（如圆角矩形）作为放大显示区域，将单元格内容复制到其中并以大字体显示来模拟放大效果。再利用鼠标移动动态更新其位置和内容
模块顶部声明几个必要的API函数和1个自定义类型
#If VBA7 Then Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long#Else Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long#End IfPrivate Type POINTAPI X As Long Y As LongEnd Type' 声明必要的API函数，用于延时#If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#End If
主程序代码实现功能：创建一个Shape对象，并设置其外观、颜色和字体等属性。最后，通过设定总时长（例如20秒），来控制程序每2秒执行一次放大镜功能，20秒后功能将自动停止
Sub MainPro() Dim endTime As Double Dim durationSeconds As Long Dim shp As Shape On Error Resume Next Set shp = ActiveSheet.Shapes("MyLabel") On Error GoTo 0 If shp Is Nothing Then ' 创建放大镜形状 Set shp = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 0, 0, 200, 80) shp.Name = "MyLabel" With shp.TextFrame2 .VerticalAnchor = msoAnchorMiddle .TextRange.Font.Size = 24 ' 设置放大字体 .TextRange.Font.NameComplexScript = "隶书" .TextRange.Font.Name = "隶书" .TextRange.Font.NameFarEast = "隶书" .TextRange.Font.Bold = msoTrue .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0) '字体颜色 End With 'shp.Fill.ForeColor.RGB = RGB(255, 250, 235) ' 设置背景色 shp.Line.ForeColor.RGB = RGB(255, 245, 215) ' 设置边框 shp.Visible = msoFalse ' 初始隐藏 With shp.Fill .ForeColor.RGB = RGB(255, 230, 160) '渐变效果，深到浅 .OneColorGradient msoGradientHorizontal, 1, 0.5 .GradientStops.Insert RGB(255, 250, 235), 0.5 ' 在中间位置添加过渡色,淡 End With End If durationSeconds = 20 ' 设置时长（秒） endTime = Timer + durationSeconds Do While Timer < endTime Sleep 2000 '暂停2秒 Call MagnifyingByMouse(shp) ' 调用函数 DoEvents ' 转让控制权，避免程序无响应 Loop MsgBox "放大效果结束。"End Sub
子过程代码，根据鼠标坐标位置定位所在单元格，并读取单元格内容到Shape中，实现放大效果 Sub MagnifyingByMouse(shp As Shape) Dim lppt As POINTAPI Dim res As Long Dim c As Range ' 获取当前鼠标光标在屏幕上的位置 res = GetCursorPos(lppt) ' 使用屏幕坐标，通过RangeFromPoint获取该点的对象 Set c = ActiveWindow.RangeFromPoint(lppt.X, lppt.Y) ' 检查获取的对象是否为单元格，并选中它 If Not c Is Nothing Then If TypeName(c) = "Range" Then c.Select ' 选中该单元格 shp.TextFrame2.TextRange.Text = c.Value ' 更新放大镜位置（例如，显示在单元格右下方） shp.Left = c.Offset(0, 1).Left shp.Top = c.Top ' 显示放大镜 shp.Visible = msoTrue Else shp.Visible = msoFalse '隐藏放大镜 End If End IfEnd Sub
好了，今天的编程知识到此结束了，又到每日分享冷知识的时间了
大家还记得Windows 95启动音乐吗？那段经典的旋律的创作者是著名音乐家布莱恩·伊诺，在一台苹果电脑上使用音乐软件完成的。虽然旋律极简，只有3.25秒，却成了全球数十亿用户共同的听觉记忆，也是艺术与商业完美结合的经典案例
本公众号一直在不间断地分享免费的编程案例和实用技巧。无论您是用来提升自动化办公效率还是想提升自我，请关注我的公众号，解锁更多的编程知识
10个月宝宝每天需要喝多少奶粉？
