实现在PPT演示过程中,用鼠标拖动图片.pdf
实现在 PPT 演示过程中，用鼠标拖动图片 1新建一个 ppt 空白文档。2点击菜单：“工具宏宏”，出现对话框。3对话框中“宏名”写：drop（其他也可以），再点“创建”，就进入代码模式。4“Sub drop()End Sub”，类似的三句全删掉。把下面的代码全拷贝进去。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 Long)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 (ByVal x As Long,ByVal y As Long,ByVal 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 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):=dx dy=GetSystemMetrics(SM_SCREENY):=dy GetCursorPos mPoint With mWnd=WindowFromPoint,GetWindowRect mWnd,WR sx=sy=dx=-/dy=-/With If dx dy Then sx=sx+(dx-dy)*/2 dx=dy End If If dy dx Then sy=sy+(dy-dx)*/2 dy=dx End If While dragMode GetCursorPos mPoint =-sx)/dx-/2 =-sy)/dy-/2 DoEvents i=i+1:If i 2000 Then dragMode=False:Exit Sub Wend End Sub 5点击保存后，关闭代码模式，回到 ppt 设计页面。在你需要拖动的图片上点右键，选择“动作设置单击鼠标运行宏确定”。然后就看效果吧。
