目的
希望在PPT演示过程中使用鼠标任意改变图像的位置,虽然我是希望能够有顺畅的拖动效果,但是没做到…,只能瞬移
效果
为某一图像添加宏之后,演示过程中单击图像进入移动状态,直接移动鼠标,一定延时后图像移动至鼠标位置(单机图像+直接移动)
步骤
- 新建.pptx,更改后缀为.pptm
- 设置PPT允许运行宏:文件->左下选项->信任中心设置->启动宏
- 启用开发工具选项:文件->左下选项->自定义功能->开发工具
- 开发工具->Visual Basic->右键新建模块->粘贴宏代码
- 为图片加入动作:插入->动作->单击时运行宏 (多张图就都设置一下)
宏
'启用选项显式声明,要求声明所有使用的变量
Option Explicit
' 使用WindowsAPI
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Type POINTAPI
x As Long
y As Long
End Type
Dim dragMode As Boolean '当前拖动状态
Const SM_CXSCREEN = 0 '屏幕像素宽
Const SM_CYSCREEN = 1 '高
' 点击图片切换状态
Sub ImageClicked(sh As Shape)
dragMode = Not dragMode
If dragMode Then Drag sh
End Sub
' 可拖动则开始拖动
Private Sub Drag(sh As Shape)
Dim imgX As Integer, imgY As Integer '图像位置
Dim presWidth As Long '演示窗口大小
Dim presHeight As Long
Dim screenWidth As Long '屏幕大小
Dim screenHeight As Long
Dim ratioWidth As Double '比例
Dim ratioHeight As Double
Dim oldX As Long
Dim oldY As Long
Dim cursorPos As POINTAPI '鼠标位置
' 获取当前鼠标在屏幕上的位置
Call GetCursorPos(cursorPos)
oldX = cursorPos.x
oldY = cursorPos.y
imgX = sh.Left
imgY = sh.Top
' MsgBox "图像左上" & x & "," & y
presWidth = ActivePresentation.SlideMaster.Width
presHeight = ActivePresentation.SlideMaster.Height
' MsgBox "演示文稿大小:" & presWidth & " x " & presHeight '(960,540)
screenWidth = GetSystemMetrics(SM_CXSCREEN)
screenHeight = GetSystemMetrics(SM_CYSCREEN)
' MsgBox "屏幕大小:" & screenWidth & " x " & screenHeight '(1920, 1080)
ratioWidth = screenWidth / presWidth
ratioHeight = screenHeight / presHeight
' MsgBox "ratio : " & ratioWidth & "," & ratioHeight
Dim i As Integer
i = 0
While dragMode
Call GetCursorPos(cursorPos)
sh.Left = imgX + (cursorPos.x - oldX) / ratioWidth
sh.Top = imgY + (cursorPos.y - oldY) / ratioHeight
i = i + 1: If i > 1000 Then dragMode = False: Exit Sub
' DoEvents
Wend
End Sub
说明
在运行visual basic宏的时候似乎是阻塞其他,所以图像不会及时刷新,但是使用DoEvents交还控制权给操作系统来处理这些绘图事件又会显得卡顿,所以还是放弃连续拖动,直接瞬移吧
方法非常的蠢,循环了1000次持续捕捉鼠标位置并更新图像位置,所以可供拖动的时间可能受电脑处理速度影响,可以自己调整倒数第3行循环次数 If i>1000