PPT中如何实现图片的任意拖拽

锦江渔夫

一个PPT制作群里面帖出来的，现转发于此。自己没试过，但或许对有的老师有用。

图片或图形的任意拖拽在课件和游戏中经常用到。PPT中要实现图片或图形的任意拖拽需要通过VBA编程。现介绍利用图像控件实现图片任意拖拽的方法：

1.在演示文稿插入图像控件，打开属性窗口，将picture设成你想拖动的图片，遗憾的是Image控件不支持透明。

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

Dim X1, Y1 As Integer

Dim Down As Boolean

Private Sub Image1_MouseDown(ByVal ButtonAs Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

If Not Down Then

X1 = X

Y1 = Y

Down = True

End If

End Sub

Private Sub Image1_MouseMove(ByVal ButtonAs Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

If Down Then

Image1.Left = Image1.Left + X - X1

Image1.Top = Image1.Top + Y - Y1

X1 = X

Y1 = Y

End If

End Sub

Private Sub Image1_MouseUp(ByVal Button AsInteger, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Down = False

SlideShowWindows(1).View.First

End Sub

运行，OK。

代码很简单，如果你想拖动多张图片，如法炮制，复制上面的三个鼠标事件，修改Image1、X1、Y1。

该贴已经同步到 锦江渔夫的微博

qiusi

试了一下，运行的时候出现错误，是不是代码这里需要修改什么呢？

qiusi

修改了一下，代码为即可：
Dim X1, Y1 As Integer
Dim Down As Boolean

Dim X2, Y2 As Integer
Dim Down2 As Boolean

'——————————————————————————
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Not Down Then
    X1 = X
    Y1 = Y
    Down = True
    End If
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Down Then
    Image1.Left = Image1.Left + X - X1
    Image1.Top = Image1.Top + Y - Y1
    X1 = X
    Y1 = Y
    End If
End Sub
Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Down = False
    SlideShowWindows(1).View.First
End Sub

Private Sub Image1_Click()

End Sub
其中如果多张图片的话，就复制代码贴在后面，将Image1中的1改为2（记得要改全哦）以此类推即可

qiusi

我也明白楼主的代码问题在哪里了，就是ButtonAs是两个单词，楼主的没有隔开，加个空格键即可，后面一个也是如此
实践出真知，一点点实践就做成了

虎年生人

又学了一招

qiusi

qiusi 发表于 2012-11-25 14:58
我也明白楼主的代码问题在哪里了，就是ButtonAs是两个单词，楼主的没有隔开，加个空格键即可，后面一个也是 ...

打开视图——工具——控件箱，在这个工具条上就可以找到