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

【PPT中也能实现图片的拖动功能】

本文档内包括两种方法来实现

现对PPT中如何实现：当播放PPT时，能够随意拖动图片到指定位置（补充：通过插入制作好的FLASH 也可以实现这样的效果，后续有时间了会接着发布的，敬请期待）。、

一、通过宏实现PPT中图片的拖动功能

此处建议将宏的安全级别设置为低。

1．打开你要设置图片拖动功能的PPT。

2．点击菜单：“工具——宏——宏”，出现对话窗口。

3．填写对话窗口中的“宏名”，宏名可以随意命名，比如：wantmove，再点“创建”，就进入代码模式。

4．删去所看到的所有的代码，然后把下面的代码全拷贝进去。

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 L ong) 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, By Val 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

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设计页面。在你需要拖动的图片上鼠标右击，选择“动作设置——单击鼠标——运行宏——确定”！

6．放映幻灯片，看看效果吧。

拖动图片方式：播放PPT，在图片上单击鼠标，放开后，图片就随你鼠标移动，如果你再单击鼠标，图片就停在你单击的地方。

二、通过VBA编实现PPT中图片的拖动功能

此处建议将宏的安全级别设置为低。

1．在演示文稿插入图像控件（视图——工具栏——控件工具箱），打开属性窗口，将picture设成你想拖动的图片（图片大小要根据实际情况进行调整），遗憾的是Image控件不支持透明。

2．双击图像控件，打开的VBA编辑窗口（注意双击后先删除所有代码），复制下面的代码：

Dim X1, Y1 As Integer

Dim Down As Boolean

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Singl e, ByVal Y As Single)

If Not Down Then

X1 = X