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

实现在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 "user32.dll" (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): dPoint.x = dx

dy = GetSystemMetrics(SM_SCREENY): dPoint.y = dy

GetCursorPos mPoint

With 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.SlideHeight

End With

If dx > dy Then

sx = sx + (dx - dy) * ActivePresentation.PageSetup.SlideWidth / 2

dx = dy

End If

If dy > dx Then

sy = sy + (dy - dx) * ActivePresentation.PageSetup.SlideHeight / 2

dy = dx

End 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 Sub

Wend

End Sub
————————————————————————————————

5．点击保存后，关闭代码模式，回到ppt设计页面。在你需要拖动的图片上点右键，选择“动作设置——单击鼠标——运行宏——确定”。然后就看效果吧。

（注：专业文档是经验性极强的领域，无法思考和涵盖全面，素材和资料部分来自网络，供参考。可复制、编制，期待你的好评与关注）