请单击菜单“工具” >“ 宏” >“ 安全性”，选择安全级为“低”， 保存并关闭 PPT 。再次运行放映此 PPT 查看拖动效果

1. 请单击菜单“工具”>“宏”>“安全性”，选择安全级为“低”，请单击菜单“工具”>“宏”>“安全性”，选择安全级为“低”， 保存并关闭PPT。再次运行放映此PPT查看拖动效果 DragObject PPT2003/XP/2007 Start 请单击上方图片或文本开始拖动，移动光标至目的位置再次 单击鼠标，完成拖动

2. 制作方法 Step1 • 新建PPT文件，单击菜单“工具”>“宏”>“安全性”，选择安全级为“低” • 单击菜单“工具”>“宏”>“宏” • 在“宏名”中随意输入名称，如“Drag” • 单击“创建”，PPT将自动打开VB代码编辑窗口。删除代码编辑窗口中的如下语句： Sub 的() ' ' 宏由 xx用户 创建，日期 xxxx-xx-xx。 ' End Sub

3. 制作方法 Step2 • 全选拷贝以下文本框中的语句粘贴在VB代码编辑窗口中 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 • 关闭VB代码编辑窗口，回到PPT编辑中

4. 制作方法 Step3 • 右键单击需要拖动的对象，选择“动作设置>单击鼠标>运行宏（此时会显示有一个名为DragandDrop的宏）>确定” • 放映PPT，检查拖动效果 • 特别说明： 当此PPT转存到另一台计算机上编辑或放映时，可能仍然要先单击PPT菜单“工具”>“宏”>“安全性”，选择安全级为“低”，保存退出后，重新打开编辑、放映 经若干台计算机测试，本VBA代码未对系统造成任何损害 本VBA代码未在PPT2003以上版本中测试 本VBA代码来源于网络，感谢无私奉献的作者，感谢作者的无私奉献