实现在演示过程中,用鼠标拖动图片

2021-12-31 01:06:56 文档大全网 [ 字体：小中大 ] [ 阅读： ]

【#文档大全网# 导语】以下是®文档大全网的小编为您整理的《实现在演示过程中,用鼠标拖动图片》，欢迎阅读！
拖动,演示,鼠标,过程,现在
实现在PPT演示过程中，用鼠标拖动图片(方法二)

[ 2021-4-8 12:56:00 | By: 赵星 ]

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

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

3．对话框中“宏名〞写：drop〔其他也可以〕，再点“创立〞，就进入代码模式。

4．“Sub drop()'

' 宏由番茄花园创立，日期 2021-4-8。

'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

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设计页面。在你需要拖动的图片上点右键，选择“动作设置——单击鼠标——运行宏——确定〞。然后就看效果吧。