PPT-拖动效果

PPT拖动效果1．新建一个ppt空白文档。2．点击菜单：“工具——宏——宏”，出现对话框。3．对话框中“宏名”写：drop（其他也可以），再点“创建”，就进入代码模式。4．“Subdrop()''宏由番茄花园创建，日期2010-4-8。'EndSub”，类似的三句全删掉。把下面的代码全拷贝进去。————————————————————————————————OptionExplicitDeclareFunctionGetKeyStateLibuser32(ByValnVirtKeyAsLong)AsIntegerPrivateDeclareFunctionWindowFromPointLibuser32(ByValxPointAsLong,ByValyPointAsLong)AsLongPrivateDeclareFunctionGetWindowRectLibuser32(ByValhwndAsLong,lpRectAsRECT)AsLongPrivateDeclareFunctionGetCursorPosLibuser32(lpPointAsPointAPI)AsLongPrivateDeclareFunctionSetCursorPosLibuser32(ByValxAsLong,ByValyAsLong)AsLongPublicDeclareFunctionMonitorFromPointLibuser32.dll(ByValxAsLong,ByValyAsLong,ByValdwFlagsAsLong)AsLongPrivateDeclareFunctionGetSystemMetricsLibuser32(ByValnIndexAsLong)AsLongPrivateConstSM_SCREENX=0PrivateConstSM_SCREENY=1PrivateConstsigProc=Drag&DropPublicConstVK_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.SlideHeightEndWithIfdxdyThensx=sx+(dx-dy)*ActivePresentation.PageSetup.SlideWidth/2dx=dyEndIfIfdydxThensy=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:Ifi2000ThendragMode=False:ExitSubWendEndSub5．点击保存后，关闭代码模式，回到ppt设计页面。在你需要拖动的图片上点右键，选择“动作设置——单击鼠标——运行宏——确定”。然后就看效果吧。