两种方式实现：PPT中实现图片的拖动功能（2020年7月整理）.pdf

1 【【PPTPPT 中中也能也能实现图片的拖动功能实现图片的拖动功能】】 本文档内包括两种方法来实现本文档内包括两种方法来实现 现对 PPT 中如何实现：当播放 PPT 时，能够随意拖动图片到指定位置（补充：通过插入制作好的 FLASH 也可以实现这样的效果，后续有时间了会接着发布的，敬请期待） 一、通过宏实现 PPT 中图片的拖动功能 此处建议将宏的安全级别设置为低 1打开你要设置图片拖动功能的 PPT 2点击菜单：“工具宏宏”，出现对话窗口 3填写对话窗口中的“宏名”，宏名可以随意命名，比如：wantmove，再点“创建”，就进入代码模 式 4删去所看到的所有的代码，然后把下面的代码全拷贝进去 Option Explicit Declare Function GetKeyState Lib user32 (ByVal nVirtKey As Long) As Integer Private Declare Function WindowFromPoint Lib user32 (ByVal xPoint As Long, ByVal yPoint As L ong) As Long Private Declare Function GetWindowRect Lib user32 (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function GetCursorPos Lib user32 (lpPoint As PointAPI) As Long Private Declare Function SetCursorPos Lib user32 (ByVal x As Long, ByVal y As Long) As Long Public Declare Function MonitorFromPoint Lib user32.dll (ByVal x As Long, ByVal y As Long, By Val dwFlags As Long) As Long Private Declare Function GetSystemMetrics Lib user32 (ByVal nIndex As Long) As Long Private Const SM_SCREENX = 0 Private Const SM_SCREENY = 1 Private Const sigProc = Drag & Drop Public Const VK_SHIFT = &H10 Public Const VK_CTRL = &H11 Public Const VK_ALT = &H12 Private Type PointAPI x As Long y As Long End Type Public Type RECT Left As Long Top As Long Right As Long Bottom As Long 2 End Type Public mPoint As PointAPI, dPoint As PointAPI Public ActiveShape As Shape Dim dragMode As Boolean Dim dx As Double, dy As Double Sub DragandDrop(sh As Shape) dragMode = Not dragMode If dragMode Then Drag sh End Sub Private Sub Drag(sh As Shape) Dim i As Integer, sx As Integer, sy As Integer Dim mWnd As Long, WR As RECT dx = GetSystemMetrics(SM_SCREENX): dPoint.x = dx dy = GetSystemMetrics(SM_SCREENY): dPoint.y = dy GetCursorPos mPoint With ActivePresentation.SlideShowWindow mWnd = WindowFromPoint(mPoint.x, mPoint.y) GetWindowRect mWnd, WR sx = WR.Left sy = WR.Top dx = (WR.Right - WR.Left) / ActivePresentation.PageSetup.SlideWidth dy = (WR.Bottom - WR.Top) / ActivePresentation.PageSetup.SlideHeight End With If dx dy Then sx = sx + (dx - dy) * ActivePresentation.PageSetup.SlideWidth / 2 dx = dy End If If dy dx Then sy = sy + (dy - dx) * ActivePresentation.PageSetup.SlideHeight / 2 dy = dx End If While dragMode GetCursorPos mPoint sh.Left = (mPoint.x - sx) / dx - sh.Width / 2 sh.Top = (mPoint.y - sy) / dy - sh.Height / 2 DoEvents i = i + 1: If i 2000 Then dragMode = False: Exit Sub Wend End Sub 5点击“保存”后，关闭代码模式，回到 ppt 设计页面。

在你需要拖动的图片上鼠标右击，选择“动作 设置单击鼠标运行宏确定”！ 6放映幻灯片，看看效果吧 3 拖动图片方式：播放 PPT，在图片上单击鼠标，放开后，图片就随你鼠标移动，如果你再单击鼠标，图 片就停在你单击的地方 二、通过 VBA 编实现 PPT 中图片的拖动功能 此处建议将宏的安全级别设置为低 1在演示文稿插入图像控件（视图工具栏控件工具箱），打开属性窗口，将 picture 设成你想 拖动的图片（图片大小要根据实际情况进行调整），遗憾的是 Image 控件不支持透明 2双击图像控件，打开的 VBA 编辑窗口（注意双击后先删除所有代码），复制下面的代码： Dim X1, Y1 As Integer Dim Down As Boolean Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Singl e, ByVal Y As Single) If Not Down Then X1 = X Y1 = Y Down = True End If End Sub Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Singl e, ByVal Y As Single) If Down Then Image1.Left = Image1.Left + X - X1 Image1.Top = Image1.Top + Y - Y1 X1 = X Y1 = Y End If End Sub Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Down = False SlideShowWindows(1).View.First End Sub 3保存，关闭 VBA 编辑窗口，放映幻灯片，即可看效果了。

4如果你想拖动多张图片，如法炮制，复制上面的三个鼠标事件，修改 Image1、X1、Y1 拖动图片方式：播放 PPT，在图片上按住鼠标，并且要长按住，这样图片才会随你鼠标移动，放开后， 图片就停在你放开的地方 。