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

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

6 голосов
/ 15 марта 2012

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

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

Ответы [ 4 ]

17 голосов
/ 01 июля 2016

Вы можете создавать объекты 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:

enter image description here

Также вы должны закрыть это окно HTA в конце вашего кода на CreateObjectx86 Empty.

UPDATE

Вы можете заставить окно хоста закрываться автоматически: путем создания экземпляра класса или активной трассировки 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 проверяет состояние переменной Static oWnd VBA, вызывающей CreateObjectx86 без аргумента, через внутреннюю функцию setInterval() каждые 500 мсек, и завершает работу, если ссылка потеряна (либо пользователь нажал Сброс в окне проекта VBA, либо рабочая книга была закрыта (ошибка 1004)).

Примечание. Точки останова VBA (ошибка 57097), ячейки рабочего листа, отредактированные пользователем, открытые модальные диалоговые окна, такие как Open / Save / Options (ошибка -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
3 голосов
/ 29 июня 2013

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

1 голос
/ 06 августа 2018

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

0 голосов
/ 30 апреля 2013

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

...