Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Запуск макроса в другой сессии Excel, одновременный (параллельный) запуск нескольких сессий Excel или макросов
 
Добрый день! Подскажите, пожалуйста, как решить следующую проблему. Я работаю в книге, при этом мне нужно с разной периодичностью или одновременно(параллельно) запустить несколько макросов в других книгах. Понимаю, что можно сделать это каждый раз открывая нужную книгу и запускать соответствующий макрос. Либо запускать макросы последовательно - но это не то, нужна экономия времени. Т.е. хочу автоматизировать.
По автоматизации делаю следующее, например, - запускаю Excel как объект, открываю в нем нужную книгу и вручную запускаю макрос, тогда можно работать параллельно - так сказать полуавтомат.
Что не получается? - Запустить макрос в новой книге автоматически "правильно", он подвешивает и первую книгу, а мне в ней работать.

Пробовал следующие алгоритмы решения:
1. Через Object:
Код
Dim oXL As Object, wb As Object
Set oXL = CreateObject("Excel.Application")
oXL.Visible = True
Set wb = oXL.workbooks.Open("C:\book1.xlsm")
oXL.Run "A_macro"
'Application.Run ("'" & wb.Path & "\" & wb.Name & "'" & "!" & "A_macro")
Set oXL = Nothing

Пробовал 2 варианта запуска макроса.

2. Через Application, с проверкой создания:
Код
Dim aXL As Excel.Application
Set aXL = New Excel.Application
aXL.Visible = True
aXL.workbooks.Open "c:\book1.xlsm"
aXL.Run "A_macro"
'Application.Run ("c:\book1.xlsm!A_macro")


3. Через with, ну мало ли:
Код
  With CreateObject("Excel.Application")
    .Visible = True
    .workbooks.Open "c:\book1.xlsm"
    .Run "A_macro"
  End With


Может быть макрос не той командой запускаю - "run"?
Может копать в сторону надстройки - через личную книгу создавать ярлык и автозапуск?
Еще читал - про возможность автоматического запуска макроса при открытии файла и перехвата dde-запросов.
Помогите или направьте на путь :)

Не знаю, нужен ли тут пример, есть два файла - один исполняющий, другой исполняемый.
Изменено: psevdonim - 22 Дек 2016 14:20:47
 
psevdonim, если сделать в book1 автоматический запуск макроса, то можно просто открыть книгу в новом экземпляре приложения
Код
shell "excel.exe c:\book1.xlsm"
Или программно создать скрипт vbs, который будет делать то же, что ваш макрос, и запустить его опять же через shell.
 
Казанский, да, действительно, все гениальное просто. Про vbs - наверное нет смысла, потому что удобнее через первую сессию Excel отслеживать, но мысль интересная, попробую. Спасибо большое!

Для тех, кто не понял:
В исполняющий файл добавляем макрос
Код
sub auto_otkr()
shell "excel.exe c:\book1.xlsm" 'путь к файлу
end sub

А в исполняемый файл или в код книги "Этакнига" вставить Private Sub Auto_Open() и вызов нужного макроса через Call, либо просто переименовать исполняемый макрос в Sub Auto_Open()
 
Развивая мысль, без встраивания кода Auto_Open в структуру файла, посылаем команды клавиш в Excel:

Код
Dim Imitate As String
Imitate = Shell("excel.exe c:\book1.xlsm", 1) ' 1 = vbNormalFocus, в видимом режиме
Application.Wait Now + TimeSerial(0, 0, 20) ' ждем 20 сек, пока открывается Excel
SendKeys "%{F8}", True    ' Имитируем нажатие ALT+F8
Application.Wait Now + TimeSerial(0, 0, 1)
SendKeys "{ENTER 2}", True

Тут стоит оговориться, что будет исполнен 1й макрос в книге.

Или может можно как-то из под Shell макрос запустить? Что-нибудь типа:
Код
shell "excel.exe c:\book1.xlsm" & запуск макроса "название макроса"
Изменено: psevdonim - 22 Дек 2016 17:47:47
 
psevdonim, из-под Shell - нет. Можно сделать так, чтобы Auto_Open считывал информацию о том, какой макрос надо запустить, из текстового файла или из реестра (F1 - Registry Keyword Summary).
 
Здравствуйте Уважаемые Гуру! Прошу помощи! Подскажите каким образом можно вызвать макрос в открытой книге из другой, тоже открытой при условии, что файлы открыты в разных экземплярах эксель. Задача заключается в том что-бы вставить буфер обмена Windows в оба файла одной командой. Или скопировать уже вставленный реньж во второй файл. Сейчас пробую открывать второй экземпляр таким образом, чтобы файлы были связаны.
Код
Sub Test()

    Set xl = New Application
    Set newWB = xl.Workbooks.Open("D:\Omben2.xlsm")
    With xl.Application
        .Visible = True: .WindowState = xlNormal
        .Top = 130: .Left = 500: .Width = 240: .Height = 240
    End With
End Sub

Но после этого не могу обратиться к открытой книге. Нужно чтобы макрос работал по нажатию кнопки.
Изменено: registralex - 21 Фев 2017 03:52:29 (был без тега)
 
А зачем одевать трусы через голову? Почему не открыть книгу в том же экземпляре Экса? Открыл, вставил, закрыл. Все.
Я сам - дурнее всякого примера! ...
 
Возможности закрывать и открывать файлы нет и в одном экземпляре открыть нельзя.( В том то и дело, что через голову тяжело.
 
Доброе время суток.
Вариант, вроде, как перебрать все запущенные экземпляры Excel.
 
Попробуйте вот так, элементарно:
Код
Dim wb As Workbook
Set wb = GetObject("Книга2") 'Книга2 - заголовок окна книги, открытой в другом процессе

Но вот именно так, без расширения, иначе открывает такую книгу из документов.
 
Цитата
Hugo написал:
Но вот именно так, без расширения
Что-то, Игорь не сработало. Excel 2010 32bit, запустил два экземпляра, в одном открыта книга "Источник CRM.xlsx", в другом экземпляре в VBA выполняю код
Код
Public Sub test()
    Dim wb As Workbook
    Set wb = GetObject("Источник CRM")
    Debug.Print wb.FullName
End Sub

На GetObject получаю ошбику - Automation error. Invalid syntax.
 
GetObject, насколько помню, будет обращаться всегда к первому запущенному экземпляру приложения. Поэтому искать книги в другом экземпляре только через API...
Ну и без расширения и полного пути к файлу вряд ли получится вообще куда-то подключиться, если имя файла не совпадает с именем какого-либо доступного приложения.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Мнда, что-то сейчас тоже не работает. Но работало!
Тогда есть другое мной проверенное решение, взятое от Doober'а:

Код
Private Declare Function AccessibleObjectFromWindow& Lib "oleacc.dll" _
               (ByVal Hwnd&, _
                ByVal dwId&, _
                riid As GUID, _
                xlwb As Object)
 Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                     (ByVal hWnd1 As Long, _
                                      ByVal hWnd2 As Long, _
                                      ByVal lpsz1 As String, _
                                      ByVal lpsz2 As String) _
                                      As Long
 
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal Hwnd As Long, ByVal wMsg As Integer, _
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Declare Function ShowWindow Lib "user32" _
(ByVal Hwnd As Long, ByVal y As Integer) As Boolean
 
Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
 
End Type
Private Sub SetGUID(ByRef ID As GUID, Optional VerRus As Boolean = True)
If VerRus Then
 
 
With ID
        .Data1 = &H20400
        .Data2 = &H0
        .Data3 = &H0
        .Data4(0) = &HC0
        .Data4(1) = &H0
        .Data4(2) = &H0
        .Data4(3) = &H0
        .Data4(4) = &H0
        .Data4(5) = &H0
        .Data4(6) = &H0
        .Data4(7) = &H46
 
    End With
 
Else
 
 
With ID
        .Data1 = &H90140000
        .Data2 = &H16
        .Data3 = &H409
        .Data4(0) = &H0
        .Data4(1) = &H0
        .Data4(2) = &H0
        .Data4(3) = &H0
        .Data4(4) = &H0
        .Data4(5) = &HF
        .Data4(6) = &HF1
        .Data4(7) = &HCE
 
    End With
  End If
End Sub
    Sub XLref()
    
     Dim xl As Excel.Application
        Dim ob As Object
        Dim XLMAIN, XLDESK, EXCEL7 As Long
        Dim G As GUID
        SetGUID G
        XLMAIN = FindWindowEx(0, 0, "XLMAIN", vbNullString)
        While XLMAIN <> 0
            XLDESK = FindWindowEx(XLMAIN, 0, "XLDESK", vbNullString)
            EXCEL7 = FindWindowEx(XLDESK, 0, "EXCEL7", vbNullString)
            If EXCEL7 <> 0 Then
                ShowWindow XLMAIN, 8
                 ShowWindow XLDESK, 8 'SW_SHOWNA=8
                AccessibleObjectFromWindow EXCEL7, &HFFFFFFF0, G, ob
              Set xl = ob.Application
        For Each Wb In xl.Workbooks
            Debug.Print Wb.Name
        Next Wb
                           
            End If
            XLMAIN = FindWindowEx(0, XLMAIN, "XLMAIN", vbNullString)
        Wend
            
    End Sub
 
Дмитрий, это работало, на кибере тема была - подсказал Shersh,, я проверил, затем ещё и у ТС сработало без расширения... Но сейчас повторить не получилось.
P.S. Похоже что пример "от Doobera" тот же, что и по ссылке Андрея :)
Изменено: Hugo - 21 Фев 2017 11:53:41
 
Если открывать второй файл через первый как я понимаю получается связка, вот что видно в процессах:http://prntscr.com/ebguoh
У меня есть рабочии вариант наиденный в интернете, но подвязанный на событие листа, как только я от него пытаюсь уйим и повесить на кнопку выдает ошибку.
Сейчас код листа
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

      If Not Intersect(Range("A:N"), Target) Is Nothing Then
        If Not xl Is Nothing Then Cancel = True: KopyrovatZanchenie Target, xl
    End If
End Sub

код модуля
Код
Public xl As Application

Sub test()

    Dim newWB As Workbook
    Set xl = New Application
    Set newWB = xl.Workbooks.Open("D:\Omben2.xlsm")
    With xl.Application
        .Visible = True: .WindowState = xlNormal
        .Top = 130: .Left = 500: .Width = 240: .Height = 240
    End With  
Код
Sub KopyrovatZanchenie(ByRef cell As Range, ap As Application)

    Dim sh As Worksheet: Set sh = ap.Workbooks("Omben2.xlsm").Worksheets("Filtr")
    Range("a1").Resize(30, 1).Copy
    sh.Range("a1").PasteSpecial paste:=xlPasteValues
End Sub
 
Цитата
Hugo написал:
Дмитрий, это работало
Не сомневаюсь. При определенном стечении обстоятельство вполне может сработать. Если путь к файлу можно определить на основании пути файла с кодом и если в параметрах системы снята галочка "Показывать расширения для зарегистрированных типов файлов". Но на такие совпадения лучше не полагаться...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Читают тему (гостей: 1)