实现在PPT演示过程中-用鼠标拖动图片

1、实现在 PPT 演示过程中，用鼠标拖动图片1新建一个 ppt 空白文档。2点击菜单： “工具宏宏 ，出现对话框。3对话框中“宏名写： drop其他也可以，再点“创立，就进入代码模式。4“ Sub drop()'End Sub，类似的三句全删掉。把下面的代码全拷贝进去。Option ExplicitDeclare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As IntegerPrivate Declare Function WindowFromPoint Lib "user32&qu

2、ot; (ByVal xPoint As Long, ByVal yPoint As Long) As LongPrivate Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As LongPrivate Declare Function SetCursorPos Lib "

3、user32" (ByVal x As Long, ByVal y As Long) As LongPublic Declare Function MonitorFromPoint Lib "user32.dll" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As LongPrivate Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPrivate Const SM_

4、SCREENX = 0Private Const SM_SCREENY = 1 Private Const sigProc = "Drag & Drop" Public Const VK_SHIFT = &H10 Public Const VK_CTRL = &H11 Public Const VK_ALT = &H12Private Type PointAPIx As Longy As LongEnd TypePublic Type RECTLeft As LongTop As LongRight As LongBottom As Long

5、End TypePublic mPoint As PointAPI, dPoint As PointAPIPublic ActiveShape As ShapeDim dragMode As BooleanDim dx As Double, dy As DoubleSub DragandDrop(sh As Shape) dragMode = Not dragModeIf dragMode Then Drag shEnd SubPrivate Sub Drag(sh As Shape)Dim i As Integer, sx As Integer, sy As IntegerDim mWnd

6、As Long, WR As RECT dx = GetSystemMetrics(SM_SCREENX): dPoint.x = dxdy = GetSystemMetrics(SM_SCREENY): dPoint.y = dyGetCursorPos mPointmWnd = WindowFromPoint(mPoint.x, mPoint.y)GetWindowRect mWnd, WREnd WithIf dx > dy Thensx = sx + (dx - dy) * ActivePresentation.PageSetup.SlideWidth / 2 dx = dyEnd IfIf dy > dx Thensy = sy + (dy - dx) * ActivePresentation.PageSetup.SlideHeight / 2 dy = dxEnd IfWhile dragModeGetCursorPos mPointsh.Left = (mPoint.x - sx) / dx - sh.Width / 2sh.Top = (mPoint.y - sy) / dy - sh.Height / 2DoEventsi = i + 1: If i > 2000