标签：javascript

VBA调用javascript(一)

函数接口

Function execJSFunc(filePath, funcName)
    Dim code
    Open filePath For Input As #1
    Do While Not EOF(1)
        Line Input #1, tmpCode
        code = code & tmpCode & Chr(13)
    Loop
    Close #1
 
    Set JS = CreateObject("ScriptControl")
    JS.Language = "JScript"
    JS.AddCode code
    Dim result
    result = JS.run(funcName, ThisWorkbook)
    execJSFunc = result
End Function

调用封装

Sub run(funcName)
    Dim path, fileName, pos, result
    path = ThisWorkbook.path
    pos = InStr(4, ThisWorkbook.Name, ".", 1)
    pos = Len(ThisWorkbook.Name) - 4
    fileName = Mid(ThisWorkbook.Name, 1, pos - 1)
    path = path + "" + fileName + ".js"
    result = execJSFunc(path, funcName)
    Debug.Print result
End Sub

调用示例

Sub 按钮1_Click()
    run("hello")
End Sub

test.js源码

function hello(workbook) {
    var sheets = workbook.sheets;
    sheets("Sheet1").range("a3").value = 55555;
    return workbook.sheets.count;
}

在x64 OFFICE中使用ScriptControl控件的方法

Sub Test()  
    Dim oSC As Object  
    Set oSC = CreateObjectx86("MSScriptControl.ScriptControl") ' create ActiveX via x86 mshta host  
    Debug.Print TypeName(oSC) ' ScriptControl  
    With oSC  
        '操作oSC  
    End With  
    CreateObjectx86 , True ' close mshta host window at the end  
End Sub
Function CreateObjectx86(Optional sProgID, Optional bClose = False)  
    Static oWnd As Object  
    Dim bRunning As Boolean  
    #If Win64 Then  
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0  
        If bClose Then  
            If bRunning Then oWnd.Close  
            Exit Function  
        End If  
        If Not bRunning Then  
            Set oWnd = CreateWindow()  
            oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"  
        End If  
        Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)  
    #Else  
        Set CreateObjectx86 = CreateObject("MSScriptControl.ScriptControl")  
    #End If  
End Function
Function CreateWindow()  
    Dim sSignature, oShellWnd, oProc  
    On Error Resume Next  
    sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)  
    CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe about:""about:<head><script>moveTo(-32000,-32000);document.title='x86Host'</script><hta:application showintaskbar=no /><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""", 0, False  
    Do  
        For Each oShellWnd In CreateObject("Shell.Application").Windows  
            Set CreateWindow = oShellWnd.GetProperty(sSignature)  
            If Err.Number = 0 Then Exit Function  
            Err.Clear  
        Next  
    Loop  
End Function