Создать массив последовательных чисеел - Страница 2

Старая форма входа

Страница 2 из 2 « 1 2
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создать массив последовательных чисеел (Макросы/Sub)

Создать массив последовательных чисеел

krosav4ig

Дата: Пятница, 18.11.2016, 16:58 | Сообщение № 21

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Цитата Udik, 18.11.2016 в 15:15, в сообщении № 20

офис 64, там scriptcontrol вообще никак не работает.

Есть костыль

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Udik

Дата: Пятница, 18.11.2016, 17:51 | Сообщение № 22

Группа: Друзья

Ранг: Старожил

Сообщений: 1588

Репутация: 192 ±

Замечаний: 0% ±

Excel 2016 х 64

Ага, хотел вашу функцию запустить - ругается, говорит: насяльника, объект давай.
[vba]

Код

Option Explicit

Sub test()
Debug.Print Unescape("\u0414\u0436\u0435\u043d\u0442\u0440\u0430")

End Sub

Function Unescape$(uStr$)
Dim oSC As Object
  Set oSC = CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff
    With oSC
        .Language = "JScript"
        Unescape = .Eval("Unescape(""" & uStr & """)")
    End With
CreateObjectx86 Empty
End Function

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

[/vba]
Залёт на строке
[vba]

Код

Unescape = .Eval("Unescape(""" & uStr & """)")

[/vba]

Ага, хотел вашу функцию запустить - ругается, говорит: насяльника, объект давай.
[vba]

Код