在VBA中使用JAVASCRIPT和VBSCRIPT.doc

在VBA中使用JAVASCRIPT和VBSCRIPT（1）javascript有许多函数和功能可以弥补VBA不足，如正则，数组，类，等等1)以数组为例，用JAVASCRIPT排序Sub fig8()Set x = CreateObject(msscriptcontrol.scriptcontrol)x.Language = javascriptarr = Array(aa, cc, bb, 1a)kk = Join(arr, ,)x.addcode function aa(bb)x=bb.split(,);x.sort();return x;cc = x.eval(aa( & kk & )MsgBox ccEnd Sub2)1)以数组为例，用JAVASCRIPT倒序Sub fig8()Set x = CreateObject(msscriptcontrol.scriptcontrol)x.Language = javascriptarr = Array(aa, cc, bb, 1a)kk = Join(arr, ,)x.addcode function aa(bb)x=bb.split(,);x.reverse();return x;cc = x.eval(aa( & kk & )MsgBox ccEnd Sub用VBSCRIPT的简单例子Sub fig8()Set x = CreateObject(msscriptcontrol.scriptcontrol)x.Language = vbscriptx.addcode sub aa(): msgbox hello.:end sub x.Run aaEnd Sub以前需要分开好几个模块，函数，现在可以统统放在一起了。Sub fig8()Set x = CreateObject(msscriptcontrol.scriptcontrol)x.Language = vbscriptx.addcode sub aa(): msgbox hello.:end sub : sub bb:msgbox 3:end sub :sub cc: msgbox cc:end subx.Run aax.Run bbx.Run ccEnd Sub自定义函数的用法Sub fig8()Set x = CreateObject(msscriptcontrol.scriptcontrol)x.Language = vbscriptx.addcode function sum(x,y):sum=x+y:end function bb = x.Run(sum, 2, 3)MsgBox bbEnd Sub动态改变窗口，文本框，单元格，range属性，本例改A1:z888单元格为红色Sub fig88()Set X = CreateObject(msscriptcontrol.scriptcontrol)X.Language = vbscriptX.addcode SUB AA:XX.INTERIOR.COLORINDEX=3:END SUB X.ADDOBJECT XX, A1:z888X.Run AAEnd Sub设置和调用全局变量Sub figvb()Set x = CreateObject(msscriptcontrol.scriptcontrol)x.Language = vbscriptx.addcode public x: sub aa(bb):x=bb*100:end subx.Run aa, 3b = x.codeobject.xMsgBox bEnd Sub代码放在单元格里不再是笑话：）Sub figvbs() Set x = CreateObject(msscriptcontrol.scriptcontrol) x.Language = vbscript a1 = a1=3 a2 = b1=4 a3 = msgbox a1+b1 For i = 1 To 3 x.executestatement Cells(i, 1) Next End Sub新建类可以不再需要类模块Sub figvbs() Set X = CreateObject(msscriptcontrol.scriptcontrol) X.Language = vbscript X.ADDCODE CLASS AA:PUBLIC SUB TEST():MSGBOX 类模块:END SUB:END CLASS X.ADDCODE SET YY=NEW AA Set RR = X.EVAL(YY) RR.TESTEnd Sub表达式可以直接拿来运算Sub aa()Set X = CreateObject(msscriptcontrol.scriptcontrol)X.Language = vbscriptDim ARR(2)ARR(0) = 3ARR(1) = 4*6ARR(2) = SIN(5)KK = Join(ARR, +)BB = X.EXECUTESTATEMENT(MSGBOX & KK)KK = Join(ARR, *)BB = X.EXECUTESTATEMENT(MSGBOX & KK)End Submsgbox ,inputbox 也可以作为变量Sub figtest1()Set x = CreateObject(msscriptcontrol.scriptcontrol)x.Language = vbscriptaa = msgbox bb = cc=inputboxFor i = 1 To 4If i Mod 2 = 0 Thenkk = aa & & iElsekk = bb & ( & i & )End Ifx.executestatement (kk)NextEnd Sub字符串加密(md5)Sub figtest1()Set X = CreateObject(msscriptcontrol.scriptcontrol)X.Language = vbscriptX.ADDCODE Function x(s):Set y= CreateObject(CAPICOM.HashedData):y.Algorithm =3: & _ y.Hash s:z = y.Value:x = z:End FunctionBB = X.Run(x, FIGFIG)MsgBox 字符 FIGFIG 加密后是: & BBEnd Sub数组也可以随意切割了Sub JSArraySample() Set objJS = CreateObject(ScriptControl) With objJS .Language = JScript .AddCode function JSSplit(s,d)return s.split(d); End With 文字列 = a,b,c,d,e Set b = objJS.CodeObject.JSSplit(文字列, ,) 数组也可以随意切割了 MsgBox b.slice(0, 1) MsgBox b.slice(1, 2) MsgBox b.slice(2, 5)End Sub功能更加强大的正则表达式Sub figexp()Set js = CreateObject(ScriptControl) js.Language = JScript script = abcdefg.match(/a/) result = js.eval(script) MsgBox resultEnd Subjscript返回的对象应该是一个数组，可以在VB直接调用相关函数，但又可以直接显示所有元素Sub Mytest() Set sp1 = CreateObject(ScriptControl) sp1.Language = JScript s = function sortarr(arr)return arr.toArray(); 顺序sp1.AddCode s aa = Array(张, 王, 李, 赵, 钱, 孙, 周, 吴, 郑, 王)Set bb = sp1.codeobject.sortarr(aa)MsgBox bbMsgBox bb.slice(1, 4)MsgBox bb.concat(888).concat(777)bb.push (999)MsgBox bbEnd Sub数组非交集Sub figjs()arr1 = a2:a11arr2 = b2:b6Set x = CreateObject(scriptcontrol)x.Language = jscriptx.eval (function aa(aa) return aa.toArray();)Set arr3 = x.eval(new Array();)Set y = x.codeobject.aa(arr1)Set z = x.codeobject.aa(arr2)Set m = y.concat(z)For Each mm In mIf InStrRev(m, mm) = InStr(m, mm) Then arr3.push mmNextMsgBox arr3End Sub其他的强大的数组功能Sub Mytest() Set sp1 = CreateObject(ScriptControl) sp1.Language = JScript s = function sortarr(arr)return arr.toArray(); 顺序sp1.AddCode s aa = Array(张, 王, 李, 赵, 钱, 孙, 周, 吴, 郑, 王)Set bb = sp1.codeobject.sortarr(aa)bb.push (999) 直接添加到数组末尾，不再需要重定义MsgBox bbbb.unshift (888) 直接添加到数组开头，不再需要重定义MsgBox bbbb.pop 删除最后一个元素MsgBox bbbb.shift 删除最前一个元素MsgBox bbbb.splice 2, 3, a, b, c 直接替换数组MsgBox bbEnd SubSub tst004()Set objIE = CreateObject(InternetExplorer.Application)With objIE.Navigate about:blank.Visible = 1End WithDo While objIE.Busy = TrueDoEventsLoopobjIE.Document.Write TEST & Chr(10)End SubSub tst004()Set ie = CreateObject(InternetExplorer.Application)With ie.Navigate about:blank.Visible = 1End WithDo While ie.Busy = TrueDoEventsLoopie.document.write function abcd()alert(你输入的是： +document.F1.T1.value); End Sub数组的读取Sub figjjs()Set x = CreateObject(scriptcontrol)x.Language = jscriptSet y = x.eval(aa=new Array()For i = 1 To 100y.push iNextkk = 8MsgBox x.eval(aa & kk & )End Sub把多维数组转换为一维Sub kk()a1 = 1a2 = 2b1 = 3b2 = 4Dim sc As ObjectSet sc = CreateObject(ScriptControl)sc.Language = JScripta = a1:b2sc.AddCode function aa(a)return new VBArray(a).toArray();Set n = sc.CodeObject.aa(a)MsgBox nEnd Sub把单元格作为对象传入js里Sub ava()Set x = CreateObject(scriptcontrol)x.Language = jscriptx.eval function aa(aa) return aa.value.toArray()Set y = x.Run(aa, a1:b4)MsgBox yEnd Sub把单元格作为对象传入js里Sub ava()Set x = CreateObject(scriptcontrol)x.Language = jscriptx.eval function aa(aa) return aa.font.colorindexy = x.Run(aa, a1)MsgBox yEnd Sub把workbook对象传入js里Sub ava()Set x = CreateObject(scriptcontrol)x.Language = jscriptx.eval function aa(aa) return aa.sheets.county = x.Run(aa, ThisWorkbook)MsgBox yEnd Sub传入WORKBOOK,输出A1单元格Sub ff()Set x = CreateObject(scriptcontrol)x.Language = jscriptx.eval function aa(aa) return aa.sheets(1).cells(1,1)Set y = x.Run(aa, ThisWorkbook)MsgBox yMsgBox y.RowEnd Sub创建对象和属性Sub ff()Set x = CreateObject(scriptcontrol)x.Language = jscriptx.eval aa=new Object;aa.myname=fig7Set y = x.eval(aa)MsgBox y.mynamey.myname = fig8MsgBox y.mynameEnd Sub调用其他模块，JAVASCRIPT 也可以有MSGBOX注意把代码放入WORKBOOK,不能放入模块1，至于模块1应该传入什么对象，请版主和其他高手有空研究一下，谢谢这里传入ME,就是thisworkbook，可以调用BB函数，在模块1我试过传入APPLICATION对象，但是不行，无法调用BB如果用VBE.PROJECTS对象又要修改设置不太实用Private Sub kkk() Set m_sc = CreateObject(ScriptControl) With m_sc .Language = JScript .AddObject o, Me .EVAL o.bb() End With End SubPublic Sub bb()MsgBox kkEnd Sub模块中可以传入thisworkbookPrivate Sub kkk() Set m_sc = CreateObject(ScriptControl) With m_sc .Language = JScript .AddObject o, ThisWorkbook .EVAL o.bb() End WithEnd SubPublic Sub bb() MsgBox kkEnd Subwindow对象的那些方法Sub ava()Set x = CreateObject(scriptcontrol)Set ie = CreateObject(htmlfile)x.Language = jscriptx.EVAL function aa(aa) aa.alert(1)y = x.Run(aa, ie.parentWindow)End Sub请问figfig老师，怎么调用传入的对象的方法。 Sub ava()Set x = CreateObject(scriptcontrol)x.Language = jscriptx.EVAL function aa(aa) aa.sheets(1).cells(1,1)=2y = x.Run(aa, ThisWorkbook)End SubSub ava()Set x = CreateObject(scriptcontrol)x.Language = jscriptx.EVAL function aa(aa) =by = x.Run(aa, ActiveSheet)End Sub查出是哪个函数调用本函数，Sub ava()Set x = CreateObject(scriptcontrol)Set ie = CreateObject(htmlfile)x.Language = jscriptx.EVAL var WD;function gg() WD.alert(gg.caller);function aa(aa) WD=aa;gg();function bb(aa) WD=aa;gg();y = x.Run(aa, ie.parentWindow)y = x.Run(bb, ie.parentWindow)End SubSub kkk()Set ie = CreateObject(htmlfile)Set win = ie.parentwindowwin.execscript function aa(aa)alert(aa)win.aa bbbEnd SubSub kkk()Set ie = CreateObject(htmlfile)Set win = ie.parentwindowwin.execscript function aa()alert(1);function bb()ll=setTimeout(aa(),1000)ll = win.setInterval(win.aa, 1000)MsgBox llEnd SubSETINTERVALSub ava()Set x = CreateObject(scriptcontrol)Set ie = CreateObject(htmlfile)x.Language = jscriptx.EVAL var WD;function gg() WD.alert(2);function aa(aa) WD=aa;WD.alert(1);WD.setInterval(gg,1000);y = x.Run(aa, ie.parentWindow)MsgBox 暂时不要点确定End Sub也可以这样，SETTIMEOUTSub ava()Set x = CreateObject(scriptcontrol)Set ie = CreateObject(htmlfile)x.Language = jscriptx.EVAL var WD;function gg() WD.alert(2);function aa(aa) WD=aa;WD.alert(1);WD.setTimeout(gg,1000);y = x.Run(aa, ie.parentWindow)For I = 1 To 8888888888888#DoEventsNextEnd SubSub ava()Set x = CreateObject(scriptcontrol)Set ie = CreateObject(htmlfile)x.Language = jscriptx.EVAL var bb;function aa() bb.range(a1)+=1; ;function mm(cc,dd)bb=cc;dd.setInterval(aa,2000)y = x.Run(mm, ActiveSheet, ie.parentWindow)For i = 1 To 888888888888888#DoEventsNextEnd Sub可同时运行的程序下面代码可以看出JSCRIPT好像是多线程的，可以同时运行其他VBA程序，Sub ava()Set x = CreateObject(scriptcontrol)Set ie = CreateObject(htmlfile)x.Language = jscriptx.EVAL var bb;function aa() bb.range(a1)+=1; ;function mm(cc,dd)bb=cc;dd.setInterval(aa,2000)y = x.Run(mm, ActiveSheet, ie.parentWindow)For i = 1 To 888888888888888#a2 = a2 + 1DoEventsNextEnd Sub多线程，同时运行，突破VBA程序运行单线程限制Sub ava()Set x = CreateObject(scriptcontrol)Set ie = CreateObject(htmlfile)x.Language = jscriptx.EVAL var bb;function aa() bb.range(a1)+=1; ;function mm(cc,dd)bb=cc;dd.setInterval(aa,2000)y = x.Run(mm, ActiveSheet, ie.parentWindow)x.EVAL var bb;function aa() bb.range(a2)+=1; ;function mm(cc,dd)bb=cc;dd.setInterval(aa,2000)y = x.Run(mm, ActiveSheet, ie.parentWindow)For i = 1 To 888888888888888#a3 = a3 + 1DoEventsNextEnd Sub获得当前屏幕的长宽，不用APISub ava2()Set ie = CreateObject(htmlfile)Set win = ie.parentwindowMsgBox win.screen.WidthEnd Sub发送邮件Sub sendmail() CreateObject(htmlfile).parentwindow.Open mailto:myself.xyz?subject=hi&body=ha End Sub在VBA中使用JAVASCRIPT和VBSCRIPT（2）介绍 JSON JSON(JavaScript Object Notation) 是一种轻量级的数据交换格式。易于人阅读和编写。同时也易于机器解析和生成。它基于JavaScript Programming Language（/javascript）, Standard ECMA-262 3rd Edition - December 1999（http:/www.ecma-international.or . cma-st/ECMA-262.pdf）的一个子集。JSON采用完全独立于语言的文本格式，但是也使用了类似于C语言家族的习惯（包括C, C+, C#, Java, JavaScript, Perl, Python等）。这些特性使JSON成为理想的数据交换语言。JSON建构于两种结构：“名称/值”对的集合（A collection of name/value pairs）。不同的语言中，它被理解为对象（object），纪录（record），结构（struct），字典（dictionary），哈希表（hash table），有键列表（keyed list），或者关联数组 （associative array）。 值的有序列表（An ordered list of values）。在大部分语言中，它被理解为数组（array）。 这些都是常见的数据结构。事实上大部分现代计算机语言都以某种形式支持它们。这使得一种数据格式在同样基于这些结构的编程语言之间交换成为可能。JSON具有以下这些形式：对象是一个无序的“名称/值对”集合。一个对象以“”（左括号）开始，“”（右括号）结束。每个“名称”后跟一个“:”（冒号）；“名称/值 对”之间使用“,”（逗号）分隔。 数组是值（value）的有序集合。一个数组以“”（左中括号）开始，“”（右中括号）结束。值之间使用“,”（逗号）分隔。 值（value）可以是双引号括起来的字符串（string）、数值(number)、 ture、false、 null、对象（object）或者数组（array）。这些结构可以嵌套。 字符串（string）是由双引号包围的任意数量Unicode字符的集合，使用反斜线转义。一个字符（character）即一个单独的字符串（character string）。 除去一些编码细节，以下描述了完整的语言。字符串（string）与C或者Java的字符串非常相似。除去未曾使用的八进制与十六进制格式，数值（number）也与C或者Java的数值非常相似。空白可以加入到任何符号之间。 Sub figjson() aa = myname:figfig, myid:888 Set x = CreateObject(ScriptControl) x.Language = JScript s = function j(s) return eval( + s + ); x.AddCode s Set y = x.CodeObject.j(aa) MsgBox y.myname MsgBox y.myidEnd Sub例子2Sub figjson2() aa = myname:alonely, age:24, email:,, family:parents:父亲,母亲,toString:function()return 家庭成员; Set x = CreateObject(ScriptControl) x.Language = JScript s = function j(s) return eval( + s + ); x.AddCode s Set y = x.Run(j, aa) MsgBox y.myname MsgBox y.ageMsgBox y.emailMsgBox y.familyMsgBox y.family.parentsEnd Sub多重结构，树状显示，类似XML节点树，代码比XML简洁得多Sub figjson3()aa = myname:Michael,myaddress:city:Beijing,street: Chaoyang Road ,postcode:100025 Set X = CreateObject(ScriptControl) X.Language = JScript s = function j(s) return eval( + s + ); X.AddCode s Set y = X.Run(j, aa) MsgBox y.myname MsgBox y.myaddressMsgBox y.myaddress.cityMsgBox y.myaddress.postcodeEnd Sub数组放入对象里Sub figjson4()aa = people: firstName: Brett, lastName:McLaughlin, email: brettnewI , firstName: Jason, lastName:Hunter, email: , firstName: Elliotte, lastName:Harold, email: Set X = CreateObject(ScriptControl) X.Language = JScript s = function j(s) return eval( + s + ).people1); X.AddCode s Set y = X.Run(j, aa) MsgBox y.firstName MsgBox y.emailEnd Sub可用单引号代替2个双引号，简化写法，如例子一Sub figjson() aa = myname:figfig, myid:888 Set x = CreateObject(ScriptControl) x.Language = JScript s = function j(s) return eval( + s + ); x.AddCode s Set y = x.CodeObject.j(aa) MsgBox y.myname MsgBox y.myidEnd Sub在EXCEL中的应用如SHEET1 A1单元格为AA, B1单元格为BBSub figjson() aa = & a1 & : & b1 & Set x = CreateObject(ScriptControl) x.Language = JScript s = function j(s) return eval( + s + ); x.AddCode s Set y = x.CodeObject.j(aa) MsgBox y.aaEnd Sub传递数值值Sub figjson() Set x = CreateObject(ScriptControl) x.Language = JScript s = var a=2 ;var b=3;var cc=a:a,b:b x.AddCode s Set y = x.CodeObject.cc MsgBox y.aEnd Sub动态添加数据Sub figjson() Set x = CreateObject(ScriptControl) x.Language = JScript s = var a=2 ;var b=3;var cc=a:a,b:b;cc电话=8888; x.AddCode s Set y = x.CodeObject.cc MsgBox y.电话 End Sub数据动态变化Sub figjson() Set x = CreateObject(ScriptControl) x.Language = JScript s = var a=2 ;var b=3;var cc=a:a,b:b;cc电话=8888; x.AddCode s Set y = x.CodeObject.cc MsgBox y.电话 s = cc电话=9999; x.AddCode s MsgBox y.电话 End Sub用变量来查询Sub figjson()Set x = CreateObject(ScriptControl)x.Language = JScripts = var cc=name:figfig,id:888,tel:1234;x.AddCode s kk = namey = x.eval(cc & kk & ) MsgBox y kk = id y = x.eval(cc & kk & ) MsgBox y kk = tel y = x.eval(cc & kk & ) MsgBox y End Sub与VB比较，代码更加简洁明了，可作为小型数据库Sub vb代码()Name = bbIf Name = aa Then Address = usIf Name = bb Then Address = cnIf Name = cc Then Address = ukMsgBox AddressName = ccIf Name = aa Then Address = usIf Name = bb Then Address = cnIf Name = cc Then Address = ukMsgBox AddressEnd SubSub fjson代码() Set x = CreateObject(ScriptControl) x.Language = JScript s = var address=aa:us,bb:cn,cc:uk x.AddCode sName = bbAddress = x.eval(address & Name & )MsgBox AddressName = ccAddress = x.eval(address & Name & )MsgBox AddressEnd Sub类似数组，可增加和删除数据Sub figjs() Set x = CreateObject(ScriptControl) x.Language = JScript s = var address=bb:0 ; x.AddCode s For i = 1 To 100s = address & i & = & i & ; x.AddCode sNextAddress = x.eval(address88)MsgBox AddressAddress = x.eval(address77)MsgBox Addressx.eval (delete address77)Address = x.eval(address77)MsgBox AddressEnd Sub在VBA中使用JAVASCRIPT和VBSCRIPT（3）phpjs是用js实现php同名函数，对PHP熟悉而对JS一般熟悉的人一定写过一些类似PHP函数的JS函数，PHP的函数应该是这个世界上最丰富的函数库了，因为它是由全世界各地PHPER共同完成的（不过很多PHP函数并没有内置，而需要额外安装）。所以能实现PHP的函数的JS，那么在开发中应该是相当有利。PHPJS是一个国外开源项目，就是以JAVASCRIPT来实现PHP中的常用内置函数。包括serialize()，强悍的file_get_contents()，强悍的file()，require具体函数用法查询/functions/index已使用PHP的倒转字符串函数 STRREV 为例注意:先把附件的PHP.JS解压到c盘下面.Sub figphp()Set x = CreateObject(scriptcontrol)x.Language = jscriptSet f = CreateObje