vba - ScriptControlをExcel2010x64で動作させる

Question

私はこれに与えられた解決策を使おうとしていますが、最も基本的なものを実行しようとすると、Object not Definedエラーが発生します。これは私のせいだと思いました（ScriptControlをインストールしていません）。しかし、ここで説明されているようにインストールしようとしましたが、役に立ちませんでした。

Office201064ビットでWindows7Professionalx64を実行しています。

score 26 · Accepted Answer

のようなActiveXオブジェクトを作成できますScriptControl。これは、64ビットVBAバージョンのmshta x86ホストを介して32ビットOfficeバージョンで利用できます。次に例を示します（コードを標準のVBAプロジェクトモジュールに配置します）。

Option Explicit

Sub Test()
    
    Dim oSC As Object
    
    Set oSC = CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff
    
    CreateObjectx86 Empty ' close mshta host window at the end
    
End Sub

Function CreateObjectx86(sProgID)
   
    Static oWnd As Object
    Dim bRunning As Boolean
    
    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        If IsEmpty(sProgID) 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
        If Not IsEmpty(sProgID) Then Set CreateObjectx86 = CreateObject(sProgID)
    #End If
    
End Function

Function CreateWindow()

    ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
    Dim sSignature, oShellWnd, oProc
    
    On Error Resume Next
    Do Until Len(sSignature) = 32
        sSignature = sSignature & Hex(Int(Rnd * 16))
    Loop
    CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe 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

いくつかの欠点mshta.exeがあります。タスクマネージャーに一覧表示されている別のプロセスを実行する必要があり、Alt+Tab非表示のHTAウィンドウが表示されます。

また、コードの最後にあるHTAウィンドウを。で閉じる必要がありますCreateObjectx86 Empty。

アップデート

クラスインスタンスまたはmshtaアクティブトレースを作成することにより、ホストウィンドウを自動的に閉じることができます。

最初のメソッドPrivate Sub Class_Terminate()は、ウィンドウを閉じるために使用するラッパーとしてクラスインスタンスを作成することを前提としています。

注：コードの実行中にExcelがクラッシュした場合、クラスは終了しないため、ウィンドウはバックグラウンドのままになります。

以下のコードを次の名前のクラスモジュールに配置しますcMSHTAx86Host。

    Option Explicit
    
    Private oWnd As Object
    
    Private Sub Class_Initialize()
        
        #If Win64 Then
            Set oWnd = CreateWindow()
            oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID) End Function", "VBScript"
        #End If
        
    End Sub
    
    Private Function CreateWindow()
    
        ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
        Dim sSignature, oShellWnd, oProc
        
        On Error Resume Next
        Do Until Len(sSignature) = 32
            sSignature = sSignature & Hex(Int(Rnd * 16))
        Loop
        CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe 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

    Function CreateObjectx86(sProgID)
       
        #If Win64 Then
            If InStr(TypeName(oWnd), "HTMLWindow") = 0 Then Class_Initialize
            Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
        #Else
            Set CreateObjectx86 = CreateObject(sProgID)
        #End If
        
    End Function
    
    Function Quit()
       
        #If Win64 Then
            If InStr(TypeName(oWnd), "HTMLWindow") > 0 Then oWnd.Close
        #End If
        
    End Function
    
    Private Sub Class_Terminate()
    
       Quit
        
    End Sub

以下のコードを標準モジュールに入れます。

Option Explicit

Sub Test()
    
    Dim oHost As New cMSHTAx86Host
    Dim oSC As Object
    
    Set oSC = oHost.CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff
    
    ' mshta window is running until oHost instance exists
    ' if necessary you can manually close mshta host window by oHost.Quit
    
End Sub

なんらかの理由でクラスを使いたくない人のための2番目の方法。重要なのは、mshtaウィンドウが500ミリ秒ごとに内部関数を介して引数なしでVBAのStatic oWnd変数呼び出しの状態をチェックし、参照が失われた場合に終了することです（ユーザーがVBAプロジェクトウィンドウでリセットを押したか、ブックが閉じられた場合（エラー1004））。CreateObjectx86setInterval()

注：VBAブレークポイント（エラー57097）、ユーザーが編集したワークシートセル、開く/保存/オプション（エラー-2147418111）などの開いたダイアログモーダルウィンドウは、アプリケーションがmshtaからの外部呼び出しに応答しなくなるため、トレースを一時停止します。このようなアクションの例外は処理され、完了後もコードは引き続き機能し、クラッシュすることはありません。

以下のコードを標準モジュールに入れます。

Option Explicit

Sub Test()
    
    Dim oSC As Object
    
    Set oSC = CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff
    
    ' mshta window is running until Static oWnd reference to window lost
    ' if necessary you can manually close mshta host window by CreateObjectx86 Empty
    
End Sub

Function CreateObjectx86(Optional sProgID)
   
    Static oWnd As Object
    Dim bRunning As Boolean
    
    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        Select Case True
            Case IsMissing(sProgID)
                If bRunning Then oWnd.Lost = False
                Exit Function
            Case IsEmpty(sProgID)
                If bRunning Then oWnd.Close
                Exit Function
            Case Not bRunning
                Set oWnd = CreateWindow()
                oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID) End Function", "VBScript"
                oWnd.execScript "var Lost, App;": Set oWnd.App = Application
                oWnd.execScript "Sub Check(): On Error Resume Next: Lost = True: App.Run(""CreateObjectx86""): If Lost And (Err.Number = 1004 Or Err.Number = 0) Then close: End If End Sub", "VBScript"
                oWnd.execScript "setInterval('Check();', 500);"
        End Select
        Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
    #Else
        Set CreateObjectx86 = CreateObject(sProgID)
    #End If
    
End Function

Function CreateWindow()

    ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
    Dim sSignature, oShellWnd, oProc
    
    On Error Resume Next
    Do Until Len(sSignature) = 32
        sSignature = sSignature & Hex(Int(Rnd * 16))
    Loop
    CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe 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

更新2

Scriptlet.TypeLib許可の問題が通知されたため、拒否されました。

score 4 · Accepted Answer

コントロールの32ビットバージョンの場合、64ビットの代替品が利用可能です。Tabalacusスクリプト制御のためのグーグル。https://github.com/tablacus/TablacusScriptControl。必要に応じて、無料のVSバージョンを使用してコントロールをコンパイルできます。

score 3 · Accepted Answer

残念ながら、scriptcontrolは32ビットコンポーネントのみであり、64ビットプロセス内では実行されません。

vba - ScriptControlをExcel2010x64で動作させる

3 に答える 3

Related

Reference