vba 使 ScriptControl 与 Excel 2010 x64 一起使用
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/9725882/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Getting ScriptControl to work with Excel 2010 x64
提问by Proto
I am trying to use the solution given to this, however, whenever I try to run the most basic anything, I get an Object not Definederror. I thought this would be my fault (not having installed ScriptControl). However, I tried installing as described in here, to no avail.
我正在尝试使用为此提供的解决方案，但是，每当我尝试运行最基本的任何东西时，都会出现Object not Defined错误。我认为这是我的错（没有安装 ScriptControl）。但是，我尝试按照此处所述进行安装，但无济于事。
I am running Windows 7 Professional x64 with Office 2010 64 bit.
我正在使用 Office 2010 64 位运行 Windows 7 Professional x64。
采纳答案by Wolfgang Kuehn
Sadly, scriptcontrol is a 32bit component only and will not run inside a 64bit process.
遗憾的是，scriptcontrol 只是一个 32 位组件，不会在 64 位进程中运行。
回答by omegastripes
You can create ActiveX objects like ScriptControl, which available on 32-bit Office versions via mshta x86 host on 64-bit VBA version, here is the example (put the code in a standard VBA project module):
您可以ScriptControl通过 64 位 VBA 版本上的 mshta x86 主机创建 ActiveX 对象，例如在 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
sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
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
It has few shortcomings: the separate mshta.exeprocess running is necessary, which is listed in task manager, and pressing Alt+Tabhidden HTA window is shown:
它有几个缺点：需要单独的mshta.exe进程运行，在任务管理器中列出，按Alt+Tab隐藏HTA窗口显示：
Also you have to close that HTA window at the end of your code by CreateObjectx86 Empty.
此外，您必须在代码末尾关闭该 HTA 窗口CreateObjectx86 Empty。
UPDATE
更新
You can make the host window to be closed automatically: by creating class instance or mshta active tracing.
您可以使主机窗口自动关闭：通过创建类实例或 mshta 主动跟踪。
First methodassumes you create a class instance as a wrapper, which uses Private Sub Class_Terminate()to close the window.
第一种方法假设您创建一个类实例作为包装器，Private Sub Class_Terminate()用于关闭窗口。
Note: if Excel crashes while code execution then there is no class termination, so the window will stay in background.
注意：如果 Excel 在代码执行时崩溃，则没有类终止，因此窗口将保持在后台。
Put the below code in a class module named cMSHTAx86Host:
将以下代码放在名为 的类模块中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
sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
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
Put the below code in a standard module:
将以下代码放入标准模块中：
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
Second methodfor those who don't want to use classes for some reason. The point is that mshta window checks the state of VBA's Static oWndvariable calling CreateObjectx86without argument via internal setInterval()function each 500 msec, and quits if the reference lost (either user have pressed Reset in VBA Project window, or the workbook has been closed (error 1004)).
对于出于某种原因不想使用类的人的第二种方法。关键是 mshta 窗口每 500 毫秒通过内部函数检查 VBAStatic oWnd变量调用的状态，如果引用丢失，则退出（用户在 VBA 项目窗口中按下了重置，或者工作簿已关闭（错误 1004）） .CreateObjectx86setInterval()
Note: VBA breakpoints (error 57097), worksheet cells edited by user, opened dialog modal windows like Open / Save / Options (error -2147418111) will suspend the tracing since they makes application unresponsive for external calls from mshta. Such actions exceptions are handled, and after completion the code will continue to work, no crashes.
注意：VBA 断点（错误 57097）、用户编辑的工作表单元格、打开的对话框模式窗口（如打开/保存/选项）（错误 -2147418111）将暂停跟踪，因为它们使应用程序对来自 mshta 的外部调用无响应。处理此类动作异常，完成后代码将继续工作，不会崩溃。
Put the below code in a standard module:
将以下代码放入标准模块中：
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
sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
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
回答by Thomas Ludewig
For the 32 bit version of the control is a 64bit drop in replacement availeable. Google for Tabalacus script control. https://github.com/tablacus/TablacusScriptControl. Control can be compiled with the free VS Versions if you need.
对于 32 位版本的控件，可提供 64 位降级替换。Google for Tabalacus 脚本控制。https://github.com/tablacus/TablacusScriptControl。如果需要，可以使用免费的 VS 版本编译控件。
回答by Mauricio
On the VBA editor, go to Tools > References and enable Microsoft Script Control.
在 VBA 编辑器上，转至工具 > 引用并启用 Microsoft 脚本控制。
