Получение ScriptControl для работы с Excel 2010 x64

Я пытаюсь использовать решение, данное для этого, однако всякий раз, когда я пытаюсь выполнить самое основное что-либо, я получаю Object not Defined ошибка. Я думал, что это будет моя вина (не установив ScriptControl). Тем не менее, я попытался установить, как описано здесь, но безрезультатно.

Я работаю под управлением Windows 7 Professional x64 с 64-разрядной версией Office 2010.

Источник

5 ответов

Решение

К сожалению, scriptcontrol является только 32-битным компонентом и не будет работать внутри 64-битного процесса.

Источник

Вы можете создавать объекты ActiveX, такие как ScriptControl, который доступен в 32-разрядных версиях Office через хост mshta x86 в 64-разрядной версии VBA, вот пример (поместите код в стандартный модуль проекта 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

У него мало недостатков: отдельный 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
        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

Поместите приведенный ниже код в стандартный модуль:

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

Второй метод для тех, кто по какой-то причине не хочет использовать классы. Дело в том, что окно mshta проверяет состояние VBA Static oWnd вызов переменной CreateObjectx86 без аргументов через внутренний setInterval() работает каждые 500 мсек и завершается, если ссылка потеряна (либо пользователь нажал "Сброс" в окне проекта VBA, либо книга была закрыта (ошибка 1004)).

Примечание. Точки останова 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
    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
Источник

Для 32-битной версии управления доступно 64-битное снижение замены. Google для управления сценариями Tabalacus. https://github.com/tablacus/TablacusScriptControl. Управление может быть скомпилировано с бесплатными версиями VS, если вам нужно.

Источник

В решении omegastripes: если вы столкнулись с проблемами в среде VBA7, вы можете заменить #If Win64 на #If Win64 или VBA7

Источник

В редакторе VBA перейдите в Инструменты> Ссылки и включите Microsoft Script Control.

Источник
Другие вопросы по тегам