全文预览已结束
下载本文档
版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领
文档简介
实现在PPT演示过程中,用鼠标拖动图片1新建一个ppt空白文档。2点击菜单:“工具宏宏”,出现对话框。3对话框中“宏名”写:drop(其他也可以),再点“创建”,就进入代码模式。4“Sub drop() End Sub”,类似的三句全删掉。把下面的代码全拷贝进去。Option Explicit Declare Function GetKeyState Lib user32 (ByVal nVirtKey As Long) As IntegerPrivate Declare Function WindowFromPoint Lib user32 (ByVal xPoint As Long, ByVal yPoint As Long) As LongPrivate Declare Function GetWindowRect Lib user32 (ByVal hwnd As Long, lpRect As RECT) As LongPrivate Declare Function GetCursorPos Lib user32 (lpPoint As PointAPI) As LongPrivate Declare Function SetCursorPos Lib user32 (ByVal x As Long, ByVal y As Long) As LongPublic Declare Function MonitorFromPoint Lib user32.dll (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As LongPrivate Declare Function GetSystemMetrics Lib user32 (ByVal nIndex As Long) As Long Private Const SM_SCREENX = 0Private Const SM_SCREENY = 1Private Const sigProc = Drag & DropPublic Const VK_SHIFT = &H10Public Const VK_CTRL = &H11Public Const VK_ALT = &H12 Private Type PointAPI x As Long y As LongEnd Type Public Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd Type Public mPoint As PointAPI, dPoint As PointAPIPublic ActiveShape As ShapeDim dragMode As BooleanDim 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 IntegerDim mWnd As Long, WR As RECT dx = GetSystemMetrics(SM_SCREENX): dPoint.x = dxdy = GetSystemMetrics(SM_SCREENY): dPoint.y = dy GetCursorPos mPointWith 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.SlideHeightEnd With If dx dy Then sx = sx + (dx - dy) * ActivePresentation.PageSetup.SlideWidth / 2 dx = dyEnd IfIf dy dx Then sy = sy + (dy - dx) * ActivePresentation.PageSetup.SlideHeight / 2 dy = dxEnd 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
温馨提示
- 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
- 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
- 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
- 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
- 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
- 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
- 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- 2026年连江县教师招聘考试备考试题及答案解析
- 2026年杞县教师招聘笔试备考题库及答案解析
- 2026年固阳县教师招聘考试模拟试题及答案解析
- 2026中国中医科学院望京医院公开招聘康复师治疗部工作人员1人笔试参考题库及答案解析
- 2026年繁峙县教师招聘笔试备考试题及答案解析
- 2027年咸阳市实验中学公费师范生招聘(30人)笔试备考试题及答案解析
- 2026湖南张家界市永定区农业农村局招聘公益性岗位人员1人笔试备考题库及答案解析
- 中国建筑西南设计研究院有限公司2027届校园招聘考试备考试题及答案解析
- 宜宾市属国有企业人力资源中心宜宾市科技人才集团有限公司下属子公司四川科才知识产权运营有限公司2026年第三批员工公开招聘的考试备考试题及答案解析
- 2026黑龙江省迎春林业局有限公司公开招聘34人笔试备考试题及答案解析
- 2026广东广州市南沙区社区专职工作人员招聘40人考试备考试题及答案解析
- 2026课件:新生儿乳糖不耐受诊断治疗的中国专家共识
- 2026年高级职业培训师(三级)职业资格鉴定考试题库(新版)
- (2025)中国肩袖损伤修复围手术期eras护理专家共识课件
- 初中八年级历史 中国特色社会主义道路 大单元教学设计
- 2026年平安银行(上海分行)校园招聘笔试参考试题及答案详解
- GB/T 44693.4-2026危险化学品企业工艺平稳性第4部分:开工过程管理规范
- 电气控制技术说课
- 灌装工专业技能培训课件
- 中药黄芪课件
- 国学礼仪课程课件大纲
评论
0/150
提交评论