Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 2 из 2«12
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создать массив последовательных чисеел (Макросы/Sub)
Создать массив последовательных чисеел
krosav4ig Дата: Пятница, 18.11.2016, 16:58 | Сообщение № 21
Группа: Друзья
Ранг: Старожил
Сообщений: 1345
Репутация: 547 ±
Замечаний: 0% ±

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

Есть костыль


(_)Õvõ(_)
 
Ответить
Сообщение
офис 64, там scriptcontrol вообще никак не работает.

Есть костыль

Автор - krosav4ig
Дата добавления - 18.11.2016 в 16:58
Udik Дата: Пятница, 18.11.2016, 17:51 | Сообщение № 22
Группа: Друзья
Ранг: Старожил
Сообщений: 1214
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Ага, хотел вашу функцию запустить - ругается, говорит: насяльника, объект давай.
[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]
К сообщению приложен файл: 7175952.xlsm(19Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеАга, хотел вашу функцию запустить - ругается, говорит: насяльника, объект давай.
[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]

Автор - Udik
Дата добавления - 18.11.2016 в 17:51
krosav4ig Дата: Пятница, 18.11.2016, 18:09 | Сообщение № 23
Группа: Друзья
Ранг: Старожил
Сообщений: 1345
Репутация: 547 ±
Замечаний: 0% ±

Excel 2007, 2013
упс, мой косяк
должно быть [vba]
Код
Unescape = .Eval("unescape(""" & uStr & """)")
[/vba]


(_)Õvõ(_)
 
Ответить
Сообщениеупс, мой косяк
должно быть [vba]
Код
Unescape = .Eval("unescape(""" & uStr & """)")
[/vba]

Автор - krosav4ig
Дата добавления - 18.11.2016 в 18:09
Udik Дата: Пятница, 18.11.2016, 18:13 | Сообщение № 24
Группа: Друзья
Ранг: Старожил
Сообщений: 1214
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Теперь работает :) спасибо!


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеТеперь работает :) спасибо!

Автор - Udik
Дата добавления - 18.11.2016 в 18:13
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создать массив последовательных чисеел (Макросы/Sub)
Страница 2 из 2«12
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!