在VBA中使用JAVASCRIPT和VBSCRIPT

以下文字整理自http://club.excelhome.net  作者 figfig

节选了自己能明白的部分代码,还有部分php和js框架块的代码并不明白,所以就没转

代码1: 数组排序    

'正序Sub fig8()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "javascript"arr = 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 Sub                                      '倒序Sub fig8()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "javascript"arr = 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

 

'代码1Sub fig8()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "vbscript"x.addcode "sub aa(): msgbox ""hello.."":end sub "x.Run "aa"End Sub

'代码2:模块,函数放在一个sub里Sub fig8()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "vbscript"x.addcode "sub aa(): msgbox ""hello.."":end sub : sub bb:msgbox 3:end sub :sub cc: msgbox ""cc"":end sub"x.Run "aa"x.Run "bb"x.Run "cc"End Sub

'代码3:动态改变代码的结构Sub fig8()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "vbscript"arr6 = Array("aa", "bb", "cc")For Each arr In arr6x.addcode "sub " & arr & "(): msgbox """ & arr & "888"":end sub : "'在这里 一个sub过程变成了一个字符串,所以可以用函数来动态改变字符串的值达到修改代码的目的x.Run arrNextEnd Sub

'自定义函数Sub fig8()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "vbscript"x.addcode "function sum(x,y):sum=x+y:end function "bb = x.Run("sum", 2, 3)MsgBox bbEnd Sub

'改变excel对象属性Sub fig88()'本例改[A1:z888]单元格为红色Set X = CreateObject("msscriptcontrol.scriptcontrol")X.Language = "vbscript"X.addcode "SUB AA:XX.INTERIOR.COLORINDEX=3:END SUB "X.ADDOBJECT "XX", [A1:z888]X.Run "AA"End Sub

'设置全局变量Sub figvb()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "vbscript"x.addcode "public x: sub aa(bb):x=bb*100:end sub"x.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 = "vbscript"Dim ARR(2)ARR(0) = "3"ARR(1) = "4*6"ARR(2) = "SIN(5)"KK = Join(ARR, "+")BB = X.EXECUTESTATEMENT("MSGBOX " & KK)KK = Join(ARR, "*")BB = X.EXECUTESTATEMENT("MSGBOX " & KK)End Sub

'msgbox ,inputbox 也可以作为变量Sub figtest1()Set x = CreateObject("msscriptcontrol.scriptcontrol")x.Language = "vbscript"aa = "msgbox "bb = "cc=inputbox"For 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 = "vbscript"X.ADDCODE "Function x(s):Set y= CreateObject(""CAPICOM.HashedData""):y.Algorithm =3:" & _        "y.Hash s:z = y.Value:x = z:End Function"BB = 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 Sub

'JS排序Function sortarr(arr)Dim s As StringStatic sp1 As Object' s = "function sortarr(arr){return(arr.toArray().sort().reverse());}" '倒序s = "function sortarr(arr){return(arr.toArray().sort());}" '顺序If sp1 Is Nothing ThenSet sp1 = CreateObject("ScriptControl")sp1.Language = "JScript"End Ifsp1.AddCode ssortarr = Split(sp1.Run("sortarr", arr), ",")End Function

'其他的强大的数组功能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 Sub

'数组读取Sub figjjs()Set x = CreateObject("scriptcontrol")x.Language = "jscript"Set y = x.eval("aa=new Array()")For i = 1 To 100y.push iNextkk = 8MsgBox x.eval("aa[" & kk & "]")End Sub

'多维数组转一维Sub kk()[a1] = 1[a2] = 2[b1] = 3[b2] = 4Dim sc As ObjectSet sc = CreateObject("ScriptControl")sc.Language = "JScript"a = [a1:b2]sc.AddCode "function aa(a){return new VBArray(a).toArray();}"Set n = sc.CodeObject.aa(a)MsgBox nEnd Sub

'单元格对象传入jsSub ava()Set x = CreateObject("scriptcontrol")x.Language = "jscript"x.eval "function aa(aa) {return aa.value.toArray()}"Set y = x.Run("aa", [a1:b4])MsgBox yEnd Sub

'worksheet对象传入jsSub ava()Set x = CreateObject("scriptcontrol")x.Language = "jscript"x.eval "function aa(aa) {return aa.sheets.count}"y = x.Run("aa", ThisWorkbook)MsgBox yEnd Sub

'传入WORKBOOK,输出A1单元格Sub ff()Set x = CreateObject("scriptcontrol")x.Language = "jscript"x.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 = "jscript"x.eval "aa=new Object;aa.myname='fig7'"Set y = x.eval("aa")MsgBox y.mynamey.myname = "fig8"MsgBox y.mynameEnd Sub

JSON建构于两种结构：

“名称/值”对的集合。不同的语言中，它被理解为对象（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的数值非常相似。

空白可以加入到任何符号之间。

'代码1Sub 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:[""[e-mail]"",""[e-mail]""], 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"": ""[e-mail]"" },{ ""firstName"": ""Jason"", ""lastName"":""Hunter"", ""email"": ""[e-mail]"" }, { ""firstName"": ""Elliotte"", ""lastName"":""Harold"", ""email"": ""[e-mail]"" }]}"Set X = CreateObject("ScriptControl")        X.Language = "JScript"          s = "function j(s) { return eval('(' + s + ').people[1]'); }"     X.AddCode s       Set y = X.Run("j", aa)      MsgBox y.firstName      MsgBox y.emailEnd 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 = "JScript"s = "var cc={name:'figfig',id:'888',tel:'1234'};"x.AddCode s      kk = "name"y = x.eval("cc['" & kk & "']")      MsgBox y     kk = "id"y = x.eval("cc['" & kk & "']")      MsgBox y     kk = "tel"     y = x.eval("cc['" & kk & "']")      MsgBox yEnd Sub'与VB比较，代码更加简洁明了，可作为小型数据库Sub vb代码()Name = "bb"If Name = "aa" Then Address = "us"If Name = "bb" Then Address = "cn"If Name = "cc" Then Address = "uk"MsgBox AddressName = "cc"If Name = "aa" Then Address = "us"If Name = "bb" Then Address = "cn"If Name = "cc" Then Address = "uk"MsgBox AddressEnd Sub       Sub fjson代码()     Set x = CreateObject("ScriptControl")    x.Language = "JScript"          s = "var address={aa:'us',bb:'cn',cc:'uk'}"     x.AddCode sName = "bb"Address = x.eval("address['" & Name & "']")MsgBox AddressName = "cc"Address = 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("address[88]")MsgBox AddressAddress = x.eval("address[77]")MsgBox Addressx.eval ("delete address[77]")Address = x.eval("address[77]")MsgBox AddressEnd Sub

'在JS中使用类Sub hh()Set x = CreateObject("scriptcontrol")x.Language = "jscript"s = " function student(){this.name='aaa'; this.age=20;this.getname=function(){return this.name;};this.getage=function(){return this.age;}}"x.addcode sx.executestatement "var s=new student(); i=s.getname();j=s.getage();"y = x.eval("i")MsgBox yy = x.eval("j")MsgBox yEnd Sub