实现在PPT演示过程中,用鼠标拖动图片教学内容

实现在P P T演示过程中,用鼠标拖动图片
实现在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设计页面。

在你需要拖动的图片上点右键，选择“动作设置——单击鼠标——运行宏——确定”。

然后就看效果吧。