实现在PPT演示过程中，用鼠标拖动图片VIP免费

实现在PPT演示过程中，用鼠标拖动图片1．新建一个ppt空白文档。2．点击菜单：“工具——宏——宏”，出现对话框。3．对话框中“宏名”写：drop（其他也可以），再点“创建”，就进入代码模式。4．“Subdrop()'''EndSub”，类似的三句全删掉。把下面的代码全拷贝进去。————————————————————————————————OptionExplicitDeclareFunctionGetKeyStateLib"user32"(ByValnVirtKeyAsLong)AsIntegerPrivateDeclareFunctionWindowFromPointLib"user32"(ByValxPointAsLong,ByValyPointAsLong)AsLongPrivateDeclareFunctionGetWindowRectLib"user32"(ByValhwndAsLong,lpRectAsRECT)AsLongPrivateDeclareFunctionGetCursorPosLib"user32"(lpPointAsPointAPI)AsLongPrivateDeclareFunctionSetCursorPosLib"user32"(ByValxAsLong,ByValyAsLong)AsLongPublicDeclareFunctionMonitorFromPointLib"user32.dll"(ByValxAsLong,ByValyAsLong,ByValdwFlagsAsLong)AsLongPrivateDeclareFunctionGetSystemMetricsLib"user32"(ByValnIndexAsLong)AsLongPrivateConstSM_SCREENX=0PrivateConstSM_SCREENY=1PrivateConstsigProc="Drag&Drop"PublicConstVK_SHIFT=&H10PublicConstVK_CTRL=&H11PublicConstVK_ALT=&H12PrivateTypePointAPIxAsLongyAsLongEndTypePublicTypeRECTLeftAsLongTopAsLongRightAsLongBottomAsLongEndTypePublicmPointAsPointAPI,dPointAsPointAPIPublicActiveShapeAsShapeDimdragModeAsBooleanDimdxAsDouble,dyAsDoubleSubDragandDrop(shAsShape)dragMode=NotdragModeIfdragModeThenDragshEndSubPrivateSubDrag(shAsShape)DimiAsInteger,sxAsInteger,syAsIntegerDimmWndAsLong,WRAsRECTdx=GetSystemMetrics(SM_SCREENX):dPoint.x=dxdy=GetSystemMetrics(SM_SCREENY):dPoint.y=dyGetCursorPosmPointWithActivePresentation.SlideShowWindowmWnd=WindowFromPoint(mPoint.x,mPoint.y)GetWindowRectmWnd,WRsx=WR.Leftsy=WR.Topdx=(WR.Right-WR.Left)/ActivePresentation.PageSetup.SlideWidthdy=(WR.Bottom-WR.Top)/ActivePresentation.PageSetup.SlideHeightEndWithIfdx>dyThensx=sx+(dx-dy)*ActivePresentation.PageSetup.SlideWidth/2dx=dyEndIfIfdy>dxThensy=sy+(dy-dx)*ActivePresentation.PageSetup.SlideHeight/2dy=dxEndIfWhiledragModeGetCursorPosmPointsh.Left=(mPoint.x-sx)/dx-sh.Width/2sh.Top=(mPoint.y-sy)/dy-sh.Height/2DoEventsi=i+1:Ifi>2000ThendragMode=False:ExitSubWendEndSub5．点击保存后，关闭代码模式，回到ppt设计页面。在你需要拖动的图片上点右键，选择“动作设置——单击鼠标——运行宏——确定”。然后就看效果吧。