个人中心
gpt4 book ai didi

vba - 让 ScriptControl 与 Excel 2010 x64 一起工作

转载 作者：行者123 更新时间：2023-12-04 09:11:54 38 4
gpt4 key购买 nike

我正在尝试使用给 this 的解决方案，但是，每当我尝试运行最基本的任何东西时，我都会得到 Object not Defined错误。我认为这是我的错(没有安装 ScriptControl)。但是，我尝试按照 here 中的说明进行安装。 ，无济于事。

我正在运行带有 Office 2010 64 位的 Windows 7 Professional x64。

最佳答案

您可以创建 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 窗口:
enter image description here
此外，您还必须通过 CreateObjectx86 Empty 关闭代码末尾的 HTA 窗口。 .
更新
您可以使主机窗口自动关闭:通过创建类实例或 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
第二种方法对于那些出于某种原因不想使用类(class)的人。关键是 mshta 窗口检查 VBA 的状态 Static oWnd变量调用 CreateObjectx86无参数通过内部 setInterval()每 500 毫秒运行一次，如果引用丢失则退出(用户在 VBA 项目窗口中按下了重置，或者工作簿已关闭(错误 1004))。
注意:VBA 断点(错误 57097)、用户编辑的工作表单元格、打开/保存/选项等打开的对话框模式窗口(错误 -2147418111)将暂停跟踪，因为它们会使应用程序对来自 mshta 的外部调用无响应。此类 Action 异常处理，完成后代码将继续工作，不会崩溃。
将以下代码放入标准模块中: 
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由于注意到权限问题。

关于vba - 让 ScriptControl 与 Excel 2010 x64 一起工作，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/9725882/

38 4 0
文章推荐： functional-programming - 为什么函数式编程好？
文章推荐： r - 使用 ggplot2 和 dplyr 编程
文章推荐： ios5 - UINavigationController 内的 UITableViewController 下面的 iAd
文章推荐： r - 增量计算数据帧中唯一数据点的有效方法
行者123
个人简介

我是一名优秀的程序员,十分优秀！

滴滴打车优惠券免费领取
滴滴打车优惠券
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com