| 楼主 ryueifu |
VBA中,完全控制屏幕,鼠标和键盘.我在很多台电脑测试过了,都能正常运行.如出现错误,请下载 dll注册器. ryueifu_VBA.rar'欢迎使用ryueifu_VBA_API助手 '用途: 可以使用VB或VBA代码让鼠标,键盘,窗口,自动变化,你的代码可以操纵和VB没有任何关系的窗口和程序. '使用步骤详解: '1,下载压缩包ryueifu_VBA.rar,解压到一个文件夹中,比如文件夹名称为...\abc '2,压缩包中,有3个文件,一个是ryueifu_VBA.dll,这个是主文件,所有的函数都在里面.还有一个音乐文件,是个示例文件,可以替换和删除. '还有个ryueifu_VBA.xls工作簿. '3,打开ryueifu_VBA.xls,在VBE里,依次点击 工具/引用...浏览,在浏览对话框中找到ryueifu_VBA.dll,确定. 以上第三个环节,可以省略.应该可以直接运行下面的宏的. '4,鼠标置于Sub Test1 代码中,按下F5执行,如果出现注册对话框,请通知作者,索要注册码.如果听到了音乐,那说明可以正常使用了. '5,Sub Test1 中,大量被注释了的语句,可以取消注释.用来验证.下面列出了一些典型的应用,也可以单独验证. '6,不能正常使用的几种情况: 'a: 不是32位的系统 'b: Win7里,安全性设置不适当 'c: 工程引用位置不对. '特别注意: 如果想保存自己写好的代码,请复制到其他地方,因为本工作簿已经设置为不可保存模式!! Public API As New ryueifu_VBA '这句用来新建一个实例,不可删除,声明这个以后,其他模块,或工作表事件中,都可以直接使用这个对象. Public Calc As Long '计算器主窗口句柄,可以用Spy或者windowhandle函数获得 Public Bt6 As Long '计算器数字按钮6的句柄 Public EditBox As Long '计算器结果文本框的句柄 Public P As PointAPI 'PointAPI是一种点对象.P是屏幕上的一个点.P.x表示P的横坐标. Sub Test1() On Error GoTo Err1 Dim P2 As PointAPI With API Calc = .WindowHandle("Scicalc") Bt6 = .WindowHandle("Button", "6") EditBox = .WindowHandle("Edit") .Delay 2 '延迟2秒后执行 '.ActivateWindow calc '计算器成为当前活动窗口 '.ClickButton Bt6 '自动点击数字6 '.DoubleClick '在鼠标位置双击 'MsgBox .Get_ClassName_hd(calc) '得到类名 'P2.x = 1349 'P2.y = 73 'MsgBox (.GetPixelColor(P2)) 'MsgBox .GetText(EditBox) '得到结果里的文本 'P = .GetWindowLeftTop(calc) '得到计算器左上角坐标 'MsgBox P.x & "," & P.y '.LeftClick '左击 '.LeftDown '.LeftUp '.RightClick '.RightDown '.RightUp 'P.x = 1000 'P.y = 100 '.MoveCursorTo P '移动光标到点P '.MoveWindow calc, P '移动窗口到点P '.Offset P2, P, -200, 200 'MsgBox P2.x & "," & P2.y '从点P偏移到P2 '.SayString "Welcome To 北京!" '在文字接收区,接受字符串 '.SendKeys "Win+R" '按键 '.SetText EditBox, "68" '往结果框中输入数字 '.Usage '查看用法 .PlayWav ThisWorkbook.Path & "\music.wav" '播放wav文件 '.ChangeCaption calc, "新标题" '改变窗口标题 'MsgBox .WindowHandle(, "计算器") '返回计算器句柄 End With Exit Sub Err1: MsgBox Err.Description End Sub Sub 自动启动计算器() API.Delay 2 API.SendKeys "Win+R" '按下Win+R组合键, 运行 API.SayString "Calc" '在运行对话框中,自动输入calc,试图启动计算器 API.SendKeys "{Enter}" '回车确认 '注释: SendKeys 后面参数设定,如果是组合键+字母键,可以这样 "Ctrl+B" ,如果是组合键+功能F键,必须使用花括号,格式是 "Alt+{F4}",更多格式,参考VBA的SendKeys参数 '此外,还可以设定按键次数.比如 API.SendKeys "A",3 表示按A三次. End Sub Sub 句柄的获得() Calc = API.WindowHandle("Scicalc") Bt6 = API.WindowHandle("Button", "6") EditBox = API.WindowHandle("Edit") '分别得到 主窗口,按钮6,结果框的句柄 End Sub Sub 自动点鼠标() API.Delay 2 '设定延时,是为了执行宏后,腾出时间,把鼠标移动到一个位置 API.LeftClick API.DoubleClick API.RightClick '以上三句,请注释掉其中2句,测试其中任何一句 End Sub Sub 自动移动鼠标到一个位置() Dim p5 As PointAPI '这句必须的,是声明一个点对象 p5.x = 1000: p5.y = 200 'p5代表屏幕上 1000,200 这个点 API.Delay 2 API.MoveCursorTo p5 '自动移动鼠标到p5 End Sub Sub 返回一点的颜色() Dim p5 As PointAPI '这句必须的,是声明一个点对象 p5.x = 1000: p5.y = 200 'p5代表屏幕上 1000,200 这个点 API.Delay 2 MsgBox API.GetPixelColor(p5) '对话框中,返回p5点的16进制颜色值. End Sub Sub 由原始点平移() Dim p5 As PointAPI, p6 As PointAPI API.Delay 2 p5.x = 1000 p5.y = 200 API.MoveCursorTo p5 API.Delay 2 API.Offset p6, p5, -100, 100 '从p5点平移,水平方向向左移动100,垂直方向向下移动100,所以p6是900,300新点. API.MoveCursorTo p6 End Sub Sub 自动移动窗口() '请事先打开计算器,否则无效 Dim p7 As PointAPI p7.x = 800 p7.y = 230 API.Delay 2 Calc = API.WindowHandle("Scicalc") 'Calc代表计算器窗体 API.MoveWindow Calc, p7 End Sub Sub 激活计算器窗口() '请事先打开计算器,并将其最小化到任务栏 API.Delay 2 API.ActivateWindow Calc End Sub Sub 无需鼠标点击数字按钮() '请事先打开计算器,否则无效 Dim Button4 As Long Button4 = 4393496 '这个数字是按钮的句柄值,需要用spy查询. API.Delay 2 API.ClickButton Button4 End Sub Sub 播放音乐文件() API.PlayWav ThisWorkbook.Path & "\music.wav" '播放wav文件,这个路径可以是其他文件夹下的音乐. End Sub Sub 如何使用() API.Usage End Sub |
| 2楼 kk学ppt |
 (*^__^*) 嘻嘻……，来下载 |
| 3楼 ryueifu |
重要! 在个别电脑上,出现 运行时错误‘429’，ACTIVEX部件不能创建对象 这样的错误.使得本工具不能使用. 因此,使用前,大家必须同时下载这个Dll的注册工具.解压后 和ryueifu_VBA.dll 要放在同一路径下.  注册&卸载Dll.zip注册的方法是,双击 注册&卸载DLL.bat 按照提示操作. |
| 4楼 ryueifu |
用VB做的dll注册工具.可以注册电脑里的任何一个dll文件. 支持文件拖动. 如果本贴的dll文件还是出错,用这个注册试试. Regdll.rar用这个后,还是不能解决的话,请加入群61840693 或ExcelVBA群:193203228 ,找我调试. |
| 5楼 ryueifu |
两个典型的sub,鼠标在屏幕上跑.
|
| 6楼 wise |
请把署名作者: ryueifu_VBA 修改为你的ID：ryueifu |
| 7楼 ryueifu |
rivate Sub Workbook_Open() '注册、引用zyg.dll Shell "Regsvr32 /s " & VBA.Chr(34) & ThisWorkbook.Path & "zyg.dll" & VBA.Chr(34), vbHide End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) '反注册zyg.dll Shell "Regsvr32 /u /s " & VBA.Chr(34) & ThisWorkbook.Path & "zyg.dll" & VBA.Chr(34), vbHide End Sub |