《实现在ppt演示过程中-用鼠标拖动图片》由会员分享，可在线阅读，更多相关《实现在ppt演示过程中-用鼠标拖动图片（5页珍藏版）》请在金锄头文库上搜索。
1、实现在PPT演示过程中，用鼠标拖动图片1新建一个ppt空白文档。2点击菜单：“工具宏宏”，出现对话框。3对话框中“宏名”写：drop（其他也可以），再点“创建”，就进入代码模式。4“Sub drop() End Sub”，类似的三句全删掉。把下面的代码全拷贝进去。Option Explicit Declare Function GetKeyState Lib user32 (ByVal nVirtKey As Long) As IntegerPrivate Declare Function WindowFromPoint Lib user32 (ByVal xPoint As Long, By
2、Val 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 user32 (ByVal x As Long, ByVal y As Long) As LongPublic Dec
3、lare 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 Long Private Const SM_SCREENX = 0Private Const SM_SCREENY = 1Private Const sigProc = Drag & DropPublic Const V
4、K_SHIFT = &H10Public Const VK_CTRL = &H11Public Const VK_ALT = &H12 Private Type PointAPI x As Long y As LongEnd Type Public Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd Type Public mPoint As PointAPI, dPoint As PointAPIPublic ActiveShape As ShapeDim dragMode As BooleanDim dx A
5、s 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 IntegerDim mWnd As Long, WR As RECT dx = GetSystemMetrics(SM_SCREENX): dPoint.x = dxdy = GetSystemMetrics(SM_SCREENY): dPoi
6、nt.y = dy GetCursorPos mPointWith 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.SlideHeightEnd
7、With If dx dy Then sx = sx + (dx - dy) * ActivePresentation.PageSetup.SlideWidth / 2 dx = dyEnd IfIf dy dx Then sy = sy + (dy - dx) * ActivePresentation.PageSetup.SlideHeight / 2 dy = dxEnd 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 SubWend End Sub5点击保存后，关闭代码模式，回到ppt设计页面。在你需要拖动的图片上点右键，选择“动作设置单击鼠标运行宏确定”。然后就看效果吧。 顶管位置主要位于粉质粘土层，地下水位以下。开挖竖井过程中如出现异常地质情况，及时与设计单位联系，进行协商处理。施工前应与铁路供电段、电务段、通信段联系，首先探明铁路两侧施工范围内各种管线位置、埋深、并进行监护和防护。
