ppt中拖图

 

 

 

宏

 

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

 

1．新建一个ppt空白文档。

 

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

 

3．对话框中“宏名”随意写个，比如：move，再点“创建”，就进入代码模式。

 

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

 

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

 

优点：可视性强。

 

缺点：对于PPT新手来说不易操作。

三、VBA编辑

 

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

 

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

 

3．保存，关闭VBA编辑窗口，放映幻灯片，即可看效果了。

 

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

 

优点：可视性强。

 

缺点：对于PPT新手来说不易操作。

对比第二种和第三种方法，在效果上并不太一样。

 

第二种方法实现的效果是：你在图片上单击鼠标，放开后，图片就随你鼠标移动，如果你再单击鼠标，图片就停在你单击的地方。

 

第三种方法实现的效果是：你在图片上单击鼠标，并且要长按住，这样图片才会随你鼠标移动，放开后，图片就停在你放开的地方。