论坛首页数据库天梯榜凯恩移动App 手游预约

//没登陆

欢迎您来到凯恩之角，奈非天!

凯恩之角 › 暗黑破坏神III › 勇者圣殿›分享下我的荆棘火炮豆角军vbs代码

发帖

返回列表

1 234 5 6 7 / 7 页下一页

楼主: lalz

[心得分享] 分享下我的荆棘火炮豆角军vbs代码

[复制链接]

新兵

Icexxl

帖子：3

符文：20

31^#

平平淡淡才是真发表于 2016-5-15 16:31
不是这样设置吗？

他这个vbs有点问题，不适合在WIN10 64位下使用，我给这个做了点更改，把修改的地方标红了，暂停键改为了J和技能键按我自己的修改过了，请自行修改后使用。

Dim WshShell
set WshShell = CreateObject("wscript.Shell")
WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\AccessVBOM",1,"REG_DWORD"
WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Security\AccessVBOM",1,"REG_DWORD"
WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Excel\Security\AccessVBOM",1,"REG_DWORD"
Dim oExcel,oSheet,oBook, oModule
Set oExcel = CreateObject("excel.application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Sheets("Sheet1")
Set oModule = obook.VBProject.VBComponents.Add(1)
strCode = _
"Private Declare PtrSafe Function GetAsyncKeyState Lib ""user32"" (ByVal vkey As Long) As Integer" & vbCr & _
"Private Function MyHotKey(vKeyCodeas As Long) As Boolean" & vbCr & _
"MyHotKey = GetAsyncKeyState(vKeyCodeas) < 0" & vbCr & _
"End Function" & vbCr & _
"Sub try()" & vbCr & _
"Dim hwnd As Long" & vbCr & _
"Dim hd As Long" & vbCr & _
"hwnd = MyHotKey(vbKeyA)" & vbCr & _
"Sheet1.Range(""A1"").Value = hwnd" & vbCr & _
"hd = MyHotKey(vbKeyJ)" & vbCr & _
"Sheet1.Range(""A2"").Value = hd" & vbCr & _
"End Sub"
oModule.CodeModule.AddFromString strCode
oExcel.DisplayAlerts = False
t0=Timer
dim AA
AA=1
Set objShell = CreateObject("Wscript.Shell")
Do while(objShell.Appactivate("记事本")=false)
oExcel.Run "try"
if oSheet.Range("A2").Value <0 and AA=0 then
AA=1
WScript.Sleep 500
end if
Do while(AA=1 and objShell.Appactivate("记事本")=false)
oExcel.Run "try"
if oSheet.Range("A1").Value <0 then
t0=Timer
end if
if oSheet.Range("A2").Value <0 and AA=1 then
AA=0
WScript.Sleep 500
end if
t=(Timer-t0)*1000 mod 16000
if t>11000 and t<11100 then
objShell.SendKeys "{Q}"
WScript.Sleep 100
objShell.SendKeys "{Q}"
end if
if t>2000 and t<2200 then
objShell.SendKeys "{3}"
WScript.Sleep 100
objShell.SendKeys "{3}"
WScript.Sleep 100
objShell.SendKeys "{3}"
end if
if t>3000 and t<3200 then
objShell.SendKeys "{1}"
WScript.Sleep 100
objShell.SendKeys "{1}"
WScript.Sleep 100
objShell.SendKeys "{1}"
end if
if t>3900 and t<4100 then
objShell.SendKeys "{4}"
WScript.Sleep 100
objShell.SendKeys "{4}"
WScript.Sleep 100
objShell.SendKeys "{4}"
end if
WScript.Sleep 30
Loop
Loop
oBook.Close
oExcel.Quit
msgbox "程序已结束"

发表于 2016-5-15 16:55:54 |只看该作者来自：辽宁

回复举报

公爵

house0826

帖子：219

符文：143

32^#

人才济济啊，，，

发表于 2016-5-15 20:15:10 来自凯恩之角App |只看该作者来自：北京

回复举报

[armory]http://hero.d.163.com/hero/cn/house0826-5786/29113166[/armory]

骑士

red0576

帖子：131

符文：1601

33^#

好东西啊,,会写代码的都是高手~~~~~

发表于 2016-5-16 09:43:33 |只看该作者来自：广西

回复举报

[armory]http://cn.battle.net/d3/en/profile/%E5%A4%A2%E9%AD%98%E4%BF%AE%E7%BE%85-5435/hero/24125620[/armory]

国王

乐乐爱乔

帖子：4183

符文：63

34^#

Icexxl 发表于 2016-5-15 16:55
他这个vbs有点问题，不适合在WIN10 64位下使用，我给这个做了点更改，把修改的地方标红了，暂停键改为了 ...

我的就是win10 64位用起来没有问题啊

估计我的excel是2010的老版

发表于 2016-5-16 11:24:54 |只看该作者来自：江苏

回复举报

[armory]http://d3.blizzard.cn/profile/george-5463/17844677[/armory]
[armory]http://cn.battle.net/d3/en/profile/george-5463/hero/19793480[/armory][armory]http://cn.battle.net/d3/en/profile/george-5463/hero/13632692[/armory][armory]http://us.battle.net/d3/en/profile/georgelee-3451/hero/24652766[/armory]
[armory]http://us.battle.net/d3/en/profile/georgelee-3451/hero/38072755[/armory]
[armory]http://us.battle.net/d3/en/profile/georgelee-3451/hero/12237422[/armory]