Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Проблема с работой макроса в Excel 2016(32). Workbooks.Open и EnableEvents
 
Мяв!
Возникла проблема с работой макроса в Excel 2016(32).
Код был создан и отлажен в Excel 2010(32).
Для возможности считывания данных вне зависимости от состояния файла (открыт/нет||на каком компе), файл открывается в новом экземпляре Excel в режиме ReadOnly.
Проблема 1
Цитата
excel залипает на этой строке: Set wbOpen = .Workbooks.Open(kas, , True)
После чего приходится его пристреливать
Проблема 2
После пристреливания Excel, отключается обработка событий не только во втором экземпляре, но и в первом. Более того, включить ее перезагрузкой Excel не удается, только выполнив Application.EnableEvents = True. Т.е при повторном запуске Excel Workbook_Open не срабатывает.
Проблемный фрагмент кода прилагаю.
Куда можно/нужно поглядеть?

Код
Private Sub Workbook_Open()
    Sheets("ОТЧЕТ").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
                          , AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
                            AllowFiltering:=True, UserInterfaceOnly:=True
    meUpdate
End Sub
Sub meUpdate()
'..........
    Dim wbOpen As Workbook
    Dim xlApp As Application

    With Me.Sheets("ОТЧЕТ")
        '.......................
        kas = Me.Sheets("ДАНО").ListObjects("tblKassa").DataBodyRange(1).Value
        Set xlApp = New Excel.Application.EnableEvents = False
        With xlApp
            .EnableEvents = False
            '                        .Visible = True
            Set wbOpen = .Workbooks.Open(kas, , True)

            With wbOpen.Sheets("КАССА")
                '.......................
            End With
        End Sub

PS Если важно
Тестировалось на локальном компе, фактически файлы на сервере.
суть кода, обозначенного  "............" - синхронизация файлов сотрудников и босса.
 
ох уж этот 2016)) у меня тоже приколы с ним всякие.
Цитата
RAN написал:
excel залипает на этой строке: Set wbOpen = .Workbooks.Open(kas, , True)
я так понимаю это сетевой путь?
может медленное соединение/нет доступа/еще какая то хрень?
 
Остальное все работает...
Цитата
Dima S написал:
RAN  написал:excel залипает на этой строке: Set wbOpen = .Workbooks.Open(kas, , True)
Если бы это писал я... Но это пишет заказчик.
 
RAN, Уточните еще и версию ОС. Сдается что одновременно на Win10 перешли. Я тут заметил, что к несуществующим ресурсам обращение отваливается по большему таймауту. Буквально на прошлой неделе , правда автокад, напроч зависал при обращении к несуществующему линку, при этом на 7ке тотже файл отлипал почти мгновенно.
 
Изменено: БМВ - 27 Мар 2018 20:34:51
 
Да, Win10
У меня WIN7
 
Думаю, что диагноз БМВ в отношении несуществующих/недоступных ресурсов является правильным.
Владимир
 
Ну тут только проверка, Виртуалка,(на выбор от virtualBox, до встроенного в 10ку HyperV) ,  Win7, Office2016 и ..... .
 
Добрый вечер, Андрей.
Похоже, что в примере кода есть опечатки. На всякий случай отмечу их:
Вот эта строка ошибочна: Set xlApp = New Excel.Application.EnableEvents = False
Должно быть:  Set xlApp = New Excel.Application
Не объявлена переменная kas
Не хватает 2-х End With
Также нет проверки существования файла, который открывается во 2-м экземпляре Exc el.

Главная рекомендация: всегда до выполнения каких-либо действий с объектами давайте Excel загрузиться полностью.
Для этого переименуйте Workbook_Open с Вашим кодом в Workbook_Open1 , а в новой процедуре Workbook_Open напишите одну строку кода для отложенного запуска кода Workbook_Open1:
Код
Option Explicit

Private Sub Workbook_Open()
  Application.OnTime Now, Me.CodeName & ".Workbook_Open1"
End Sub

Private Sub Workbook_Open1()
  Me.Sheets("ОТЧЕТ").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
     AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
     AllowFiltering:=True, UserInterfaceOnly:=True
  meUpdate
End Sub

Sub meUpdate()
  '..........
  Dim kas As String ' <-- было пропущено
  Dim wbOpen As Workbook
  Dim xlApp As Application
  With Me.Sheets("ОТЧЕТ")
    '.......................
    kas = Me.Sheets("ДАНО").ListObjects("tblKassa").DataBodyRange(1).Value
    
    ' Проверить, что требуемый файл существует
    If Dir(kas) = "" Then
      MsgBox "Не найден файл:" & vbLf & kas, vbCritical, "Ошибка"
      Exit Sub
    End If
    
    Set xlApp = New Excel.Application ' <-- здесь было лишнее
    With xlApp
      .EnableEvents = False
      '.Visible = True
      Set wbOpen = .Workbooks.Open(kas, , True)
      With wbOpen.Sheets("КАССА")
        '.......................
      End With
    End With  ' <-- было пропущено
  End With    ' <-- было пропущено
  
  ' Закрыить книгу wbOpen и экземпляр приложения xlApp с освобождением памяти
  wbOpen.Close False
  Set wbOpen = Nothing
  xlApp.Quit
  Set xlApp = Nothing
  
End Sub
Изменено: ZVI - 27 Мар 2018 20:50:02
Vladimir Zakharov
Microsoft MVP – Office Apps & Services
 
Владимир, добрый вечер.
Конечно, строка Set xlApp = New Excel.Application.EnableEvents = False ошибочна, я ее собрал для копирования в тело сообщения. Хотел вернуть, но забыл. Виноват... Просто выкинул из кода все, что, на мой взгляд, не имеет отношения к проблеме.
Полностью код выглядит так
Код
Option Explicit
Const RowFirst& = 10

Private Sub Workbook_Open()
    Sheets("ОТЧЕТ").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
                          , AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
                            AllowFiltering:=True, UserInterfaceOnly:=True
    meUpdate
End Sub

Sub meUpdate()
    Dim kas$
    Dim ar, arKas
    Dim wbOpen As Workbook
    Dim oDic As Object
    Dim lr&, lrwbOpen&, i&
    Dim xlApp As Application

    With Me.Sheets("ОТЧЕТ")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lr > RowFirst Then
            ar = .Range(.Cells(RowFirst, 1), .Cells(lr, 1)).Value
        ElseIf lr = RowFirst Then
            ReDim ar(1 To 1, 1 To 1)
            ar(1, 1) = .Range(.Cells(RowFirst, 1), .Cells(lr, 1)).Value
        Else
            Exit Sub
        End If

        kas = Me.Sheets("ДАНО").ListObjects("tblKassa").DataBodyRange(1).Value
        Set xlApp = New Excel.Application
        With xlApp
            .EnableEvents = False
            '                        .Visible = True
            Set wbOpen = .Workbooks.Open(kas, , True)

            With wbOpen.Sheets("КАССА")
                lrwbOpen = .Cells(.Rows.Count, 1).End(xlUp).Row
                If lrwbOpen > RowFirst Then
                    arKas = .Range(.Cells(RowFirst, 1), .Cells(lrwbOpen, 1)).Value
                ElseIf lrwbOpen = RowFirst Then
                    ReDim arKas(1 To 1, 1 To 1)
                    arKas(1, 1) = .Range(.Cells(RowFirst, 1), .Cells(lrwbOpen, 1)).Value
                Else
                    wbOpen.Close False
                    .Quit
                    Exit Sub
                End If
            End With
            wbOpen.Close False
            .Quit
        End With
        Set xlApp = Nothing
        Set oDic = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            oDic.Item(ar(i, 1)) = ""
        Next
        For i = 1 To UBound(arKas)
            If oDic.exists(arKas(i, 1)) Then oDic.Item(arKas(i, 1)) = "да"
        Next
        .Range("M" & RowFirst).Resize(oDic.Count) = Application.Transpose(oDic.items)
    End With
End Sub

При дальнейшем общении с заказчиком выяснилось, что при работе (тестировании) в офисе проблем, кажется не было. Проблемы возникли при попытке работы из дома (подключение не по локальной сети, а через интернет).
Файлы точно существуют, и точно расположены по нужному адресу.

PS Но, безотносительно к проблеме, меня до кончика хвоста заинтересовало, почему при перезагрузке Excel не включается обработка событий?
Изменено: RAN - 27 Мар 2018 21:18:31
 
Здравствуйте, Владимир! Большое спасибо за рекомендации в отношении Workbook_open! Неоднократно встречался с необычным поведением Excel при обработке этого события в первой открываемой рабочей книге.
Владимир
 
Так, так, так...
Код
Private Sub Workbook_Open()
  Application.OnTime Now, Me.CodeName & ".Workbook_Open1"
End Sub

чуть не проворонил...
 
Цитата
RAN написал:
(подключение не по локальной сети, а через интернет). ту
А вот тут море предположений. Как осуществляется доступ? VPN, Direct Access, WebDAV, FTP(S) ..... Connection Bandwitch? А главное, какой антивирус дома и как настроен?
 
Цитата
RAN написал: Проблемы возникли при попытке работы из дома (подключение не по локальной сети, а через интернет)
В зависимости от того, как организовано удаленное подключение, доступа к файлу по предполагаемому пути может и не быть - добавьте все же проверку.
И добавьте отложенный запуск: загрузка некоторых процессов в Excel происходит асинхронно, код Workbook_Open может начать выполняться до полной загрузки, когда доступ к объектной модели Excel неполный. Задержка в предложенном варианте - минимальная, ее почти нет (см. Now), но есть.

Цитата
sokol92 написал: ... при обработке этого события в первой открываемой рабочей книге
Владимир, все верно - этот случай. Такие проблемы начались еще с Excel 2002 (кто помнит)
Изменено: ZVI - 27 Мар 2018 21:35:38
Vladimir Zakharov
Microsoft MVP – Office Apps & Services
 
Проверили с паузой. Не помогло.
Зато нашли интересное окошко.

Но к чему, почему, не пойму.  :cry:
 
такое может быть, когда запускаете приложение в Visible = False, а оно в момент запуска какое-то модальное окно типа ошибки выдает. Т.к. приложение скрыто - мы не можем нажать на ОК или еще что-то, а приложение этого ждет...
Изменено: Дмитрий Щербаков - 27 Мар 2018 21:42:56
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
RAN написал: почему при перезагрузке Excel не включается обработка событий?
Если был принудительно закрыт первый экземпляр, то второй невидимый же в памяти остается, поэтому любое новое открытие книги по умолчанию выполняется в экземпляре, находящемся в памяти (если есть), а там события были отключены Вашим кодом. Удаляйте все (оба) экземпляры из памяти и проблемы не должно быть
Изменено: ZVI - 27 Мар 2018 21:44:33
Vladimir Zakharov
Microsoft MVP – Office Apps & Services
 

Очень похоже на скорость доступа. Я получал такое, когда собирал данные по WMI с хостов в сети. При этом мог получать за время работы кода в цикле несколько раз, но код продолжал выполнятся.

 
Цитата
RAN написал: интересное окошко
Так и отладим по кусочкам :)
Дмитрий правильно рекомендует - включите для отладки xlApp.Visible = True.
Еще в коде очистка памяти не выполняется при Exit Sub, а очистки Set  wbOpen = Nothing вообще нет, посмотрите рекомендацию по очисткае памяти в моем коде сообщения #8. Важен еще порядок очистки, должно быть как в том сообщении.
Изменено: ZVI - 27 Мар 2018 21:53:11
Vladimir Zakharov
Microsoft MVP – Office Apps & Services
 
Всем большое спасибо. Пока берем таймаут на осмысление, исправление и тестирование.
Цитата
ZVI написал:
Если был принудительно закрыт первый экземпляр, то второй невидимый же в памяти остается, поэтому любое новое открытие книги по умолчанию выполняется в экземпляре, находящемся в памяти
Хотелось уточнить, что, и в какой памяти остается, если в диспетчере задач нет никаких упоминаний об Excel?
 
Имитация зависания для обнаружения 2-х экземпляров Excel на вкладке "процессы"  диспетчера задач (удобно отсортировать там по имени)
Код
Sub Test()
  Dim App As Application
  Set App = New Application
  Stop      ' <-- Имитация зависания, в диспетчере задач 2 экземпляра объекта Excel
  App.Quit  ' <-- и даже после этой строки будут 2 экземпляра пока не выполнится End Sub
End Sub
Vladimir Zakharov
Microsoft MVP – Office Apps & Services
 
Цитата
RAN написал:
нашли интересное окошко.
у меня такое было когда для доступа к файлу нужно было авторизоваться на сервере.
то есть ожидало окно ввода логина и пароля.
 
Цитата
RAN написал:
нашли интересное окошко
доброго вечера! У меня такая же шляпа при копировании таблицы Excel в AutoCAD (обычным копипастом). Это окно возникает при попытке закрыть Excel (xl виснет при этом) и никак, кроме принудительной выгрузки через диспетчер, закрыть не выходит.
А бывает, что ещё до завершения копирования всех нужных табличек, Excel виснет (без окна) и всё…

Может этот случай поможет как-то… Win7, 64x, xl2013/16 (обе лагают), AutoCAD 2015/16 (обе лагают)
Изменено: Jack Famous - 27 Мар 2018 23:58:45
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Dima S написал:
нужно было авторизоваться на сервере
Это тоже вариант и перекликается с моим #12. Если домашний комп ничего не знает о авторизации, то .......  Тут только предварительно NET USE ....
 
По итогам тестирования - виноват новый экземпляр Excel.
После перехода на работу в одном экземпляре проблема исчезла как локально, так и дистанционно.
Жаль, конечно, но видно не судьба... Придется работать в одном.
Еще раз всем спасибо за обсуждение.
 
RAN, а в чём конкретно-то "провинился"?))
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
В том, что с ним не работает. Куда конкретнее?
 
RAN, блииин, ну камон, кот, какие библиотеки/разрядность — нюансы и иже с ними))
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
Страницы: 1
Читают тему (гостей: 1)
Наверх