在VBA中使用JAVASCRIPT和VBSCRIPT

最新推荐文章于 2024-05-08 23:35:17 发布

杨名天吓

最新推荐文章于 2024-05-08 23:35:17 发布

阅读量9.2k

点赞数 1

分类专栏： javascript VBA office

javascript 同时被 3 个专栏收录

21 篇文章 0 订阅

订阅专栏

office

7 篇文章 0 订阅

订阅专栏

VBA

4 篇文章 0 订阅

订阅专栏

以下文字整理自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 cc
End 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 cc
End Sub

'代码1
Sub 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 arr6
x.addcode "sub " & arr & "(): msgbox """ & arr & "888"":end sub : "'在这里 一个sub过程变成了一个字符串,所以可以用函数来动态改变字符串的值达到修改代码的目的
x.Run arr
Next
End 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 bb
End 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", 3
b = x.codeobject.x
MsgBox b
End 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.TEST
End 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 4
If i Mod 2 = 0 Then
kk = aa & "  " & i
Else
kk = bb & "(" & i & ")"
End If
x.executestatement (kk)
Next
End 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 加密后是: " & BB
End 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 result
End Sub

'JS排序
Function sortarr(arr)
Dim s As String
Static sp1 As Object
' s = "function sortarr(arr){return(arr.toArray().sort().reverse());}" '倒序
s = "function sortarr(arr){return(arr.toArray().sort());}" '顺序
If sp1 Is Nothing Then
Set sp1 = CreateObject("ScriptControl")
sp1.Language = "JScript"
End If
sp1.AddCode s
sortarr = 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 bb
bb.unshift ("888") '直接添加到数组开头，不再需要重定义
MsgBox bb
bb.pop '删除最后一个元素
MsgBox bb
bb.shift '删除最前一个元素
MsgBox bb
bb.splice 2, 3, "a", "b", "c" '直接替换数组
MsgBox bb
End Sub

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

'多维数组转一维
Sub kk()
[a1] = 1
[a2] = 2
[b1] = 3
[b2] = 4
Dim sc As Object
Set 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 n
End Sub

'单元格对象传入js
Sub 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 y
End Sub

'worksheet对象传入js
Sub ava()
Set x = CreateObject("scriptcontrol")
x.Language = "jscript"
x.eval "function aa(aa) {return aa.sheets.count}"
y = x.Run("aa", ThisWorkbook)
MsgBox y
End 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 y
MsgBox y.Row
End 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.myname
y.myname = "fig8"
MsgBox y.myname
End 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的数值非常相似。

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

'代码1
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.myid
End Sub

'代码2
Sub figjson2()   
    aa = "{myname:""alonely"", age:24, email:[""aa4@bb.com"",""aa@gmail.com""], 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.age
MsgBox y.email
MsgBox y.family
MsgBox y.family.parents
End 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.myaddress
MsgBox y.myaddress.city
MsgBox y.myaddress.postcode
End Sub

'数组放入对象里
Sub figjson4()
aa = "{ ""people"": [{ ""firstName"": ""Brett"", ""lastName"":""McLaughlin"", ""email"": ""brett@newInstance.com"" },{ ""firstName"": ""Jason"", ""lastName"":""Hunter"", ""email"": ""jason@servlets.com"" }, { ""firstName"": ""Elliotte"", ""lastName"":""Harold"", ""email"": ""elharo@macfaq.com"" }]}"
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.email
End 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.a
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.电话
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 y
End 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 Address
Name = "cc"
If Name = "aa" Then Address = "us"
If Name = "bb" Then Address = "cn"
If Name = "cc" Then Address = "uk"
MsgBox Address
End Sub
       
Sub fjson代码()
     Set x = CreateObject("ScriptControl")
    x.Language = "JScript"      
    s = "var address={aa:'us',bb:'cn',cc:'uk'}"
     x.AddCode s
Name = "bb"
Address = x.eval("address['" & Name & "']")
MsgBox Address
Name = "cc"
Address = x.eval("address['" & Name & "']")
MsgBox Address
End Sub

'类似数组，可增加和删除数据
Sub figjs()
     Set x = CreateObject("ScriptControl")
    x.Language = "JScript"
      s = "var address={bb:'0' };"
     x.AddCode s  
For i = 1 To 100
s = "address[" & i & "]=" & i & ";"
     x.AddCode s
Next
Address = x.eval("address[88]")
MsgBox Address
Address = x.eval("address[77]")
MsgBox Address
x.eval ("delete address[77]")
Address = x.eval("address[77]")
MsgBox Address
End 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 s
x.executestatement "var s=new student(); i=s.getname();j=s.getage();"
y = x.eval("i")
MsgBox y
y = x.eval("j")
MsgBox y
End Sub