两种方式实现：PPT中实现图片的拖动功能

【PPT中也能实现图片的拖动功能】之蔡仲巾千创
作
本文档内包括两种方法来实现
现对PPT中如何实现：当播放PPT时,能够随意拖动图片到指定位置（弥补：通过拔出制作好的FLASH也可以实现这样的效果,后续有时间了会接着发布的,敬请期待）.、
一、通过宏实现PPT中图片的拖动功能
此处建议将宏的平安级别设置为低.
1．翻开你要设置图片拖动功能的PPT.
2．点击菜单：“工具——宏——宏”,呈现对话窗口.
3．填写对话窗口中的“宏名”,宏名可以随意命名,比如：wantmo ve,再点“创立”,就进入代码模式.
4．删去所看到的所有的代码,然后把下面的代码全拷贝进去. Option Explicit
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function WindowFromPoint Lib "user32" (By Val xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVa l hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoi nt 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" (B yVal 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
mWnd = WindowFromPoint(mPoint.x, mPoint.y) GetWindowRect mWnd, WR
End With
If dx > dy Then
sx = sx + (dx - dy) * ActivePresentation.PageSetup.Sl ideWidth / 2
dx = dy
End If
If dy > dx Then
sy = sy + (dy - dx) * ActivePresentation.PageSetup.Sl ideHeight / 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 Su b
Wend
End Sub
5．点击“保管”后,关闭代码模式,回到ppt设计页面.在你需要
拖动的图片上鼠标右击,选择“举措设置——单击鼠标——运行宏——确定”！
6．放映幻灯片,看看效果吧.
拖动图片方式：播放PPT,在图片上单击鼠标,放开后,图片就随你鼠标移动,如果你再单击鼠标,图片就停在你单击的处所.
二、通过VBA编实现PPT中图片的拖动功能
此处建议将宏的平安级别设置为低.
1．在演示文稿拔出图像控件（视图——工具栏——控件工具箱）,翻开属性窗口,将picture设成你想拖动的图片（图片年夜小要根据实际情况进行调整）,遗憾的是Image控件不支持透明.
2．双击图像控件,翻开的VBA编纂窗口（注意双击后先删除所有
代码）,复制下面的代码：
Dim X1, Y1 As IntegerDim Down As BooleanPrivate Sub Image 1_MouseDown(ByVal Button As Integer, ByVal Shift As Integ er, ByVal X As Single, ByVal Y As Single)If Not Down Then X1 = XY1 = YDown = TrueEnd IfEnd SubPrivate Sub Image1_Mo useMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)If Down ThenImage1.L eft = Image1.Left + X - X1Image1.Top = Image1.Top + Y - Y 1X1 = XY1 = YEnd IfEnd SubPrivate Sub Image1_MouseUp(ByVa l Button As Integer, ByVal Shift As Integer, ByVal X As S
ingle, ByVal Y As Single)Down = FalseSlideShowWindows(1). View.FirstEnd Sub
3．保管,关闭VBA编纂窗口,放映幻灯片,即可看效果了.
4．如果你想拖动多张图片,如法炮制,复制上面的三个鼠标事件,修改Image1、X1、Y1.
拖动图片方式：播放PPT,在图片上按住鼠标,而且要长按住,这样图片才会随你鼠标移动,放开后,图片就停在你放开的处所.。