Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Если при выполнении макроса в одной книге работать в другой, иногда возникает ошибка.
 
Здравствуйте форумчане.
Запускаю макрос в одной книге, он автоматически повторяется через каждые 10 секунд (Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Макрос1")
до выполнения определенного условия.
Если при выполнении этого макроса работать в этой или в другой книге, с активацией ячеек и ввода в них данных, бывает возникает ошибка.
Код
Sub макрос1()
On Error GoTo 1
Application.EnableCancelKey = xlDisabled
dt1 = Now
dt2 = Now + 1
obnov = 10
s = ("http://100.20.29.225")
UserForm2.WebBrowser1.Navigate (s)
Do While UserForm2.WebBrowser1.busy Or (UserForm2.WebBrowser1.ReadyState <> 4): DoEvents: Loop

v_pr1 = v_prob1
v_pr2 = v_prob2
v_D1 = Format(CDate(dt1), "dd/mm/yyyy")
v_D2 = Format(CDate(dt2), "dd/mm/yyyy")
v_N1 = Plavka1
v_N2 = Plavka2

UserForm2.WebBrowser1.Document.forms(0).elements(0).Checked = True
UserForm2.WebBrowser1.Document.forms(0).elements(13).Checked = True
UserForm2.WebBrowser1.Document.forms(0).elements(2).Value = v_pr1
UserForm2.WebBrowser1.Document.forms(0).elements(3).Value = v_pr2
UserForm2.WebBrowser1.Document.forms(0).elements(14).Value = v_D1
UserForm2.WebBrowser1.Document.forms(0).elements(15).Value = v_D2
UserForm2.WebBrowser1.Document.forms(0).elements(16).Value = v_N1
UserForm2.WebBrowser1.Document.forms(0).elements(17).Value = v_N2
UserForm2.WebBrowser1.Document.forms(0).elements(19).Checked = True

DoEvents
UserForm2.WebBrowser1.Document.forms(0).submit

DoEvents
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Do While UserForm2.WebBrowser1.busy Or (UserForm2.WebBrowser1.ReadyState <> 4): DoEvents: Loop
Set maPageHtml = UserForm2.WebBrowser1.Document
Set Htable = maPageHtml.getElementsByTagName("table")
Set maTable = Htable(1) ' the first table
Workbooks("книга1.xlsb").Worksheets("table").Cells.ClearContents 'удаляем все предыдущие записи на листе table
'запускаем цикл по всем ячейкам - последовательно заносим их на лист
For i = 1 To maTable.Rows.Length ' table rows
'DoEvents
    For J = 1 To maTable.Rows(i - 1).Cells.Length ' each cell of the row
    'DoEvents
        Workbooks("книга1.xlsb").Worksheets("table").Cells(i, J) = maTable.Rows(i - 1).Cells(J - 1).innerText
    Next J
Next i

Set maPageHtml = Nothing

DoEvents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
    
    
    
  If Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$y$30") = "2" Then   ' если появилась новая
    
    SendKeys ("{ }")

    Workbooks("книга1.xlsb").Activate
    Call Звук
    
    UserForm1.Show 0
   UserForm1.Hide
 
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$17") = "3"
    Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$16") = "1"
        Workbooks("книга1.xlsb").Sheets("Лист2").Range("$l$3") = dt1
    Workbooks("книга1.xlsb").Sheets("Лист2").Range("$m$3") = dt2
   Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$b$7") = Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$g$7")
Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$c$7") = Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$h$7")
     
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 poiskPR = Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$t$28")
    MsgBox "Плавка №: " & Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$j$4") & "  Проба №: " & Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$K$4"), vbSystemModal
Else
    If Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$16") = "5" Then
    obnov = 10
    Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Макрос1"
    End If
  
   End If
   
Exit Sub

1
Workbooks("книга1.xlsb").Activate
Call Звук2
UserForm1.Show 0
UserForm1.Hide

If MsgBox("Неполадки с сетью. Продолжить обработку?", vbYesNo) = vbYes Then
Call макрос1
Else
Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$17") = "3"
Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$16") = "1"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If

End Sub
 
Может в каком то месте блокировать клавиатуру  Application.EnableCancelKey = xlDisabled
 
Или так?
Код
Application.Interactive = False
For i = 1 To maTable.Rows.Length ' table rows
'DoEvents
    For J = 1 To maTable.Rows(i - 1).Cells.Length ' each cell of the row
    'DoEvents
        Workbooks("книга1.xlsb").Worksheets("table").Cells(i, J) = maTable.Rows(i - 1).Cells(J - 1).innerText
    Next J
Next i
Application.Interactive = True


Жаль что проверить смогу только на работе.
Изменено: Stalevar - 4 Июн 2018 13:22:08
 
А если "другую" книгу открывать в другом экземпляре Excel?
 
Юрий М, Бывает что в этой книге что то делаешь.
Попробую сегодня. Спасибо.
 
Привет!
Цитата
Stalevar написал:
при выполнении этого макроса работать в этой или в другой книге
Виртуальную машину рассматривали?
 
Ну если у вас макрос зациклен и в этот момент вы можете работать в других книгах, то тут надо рассматривать подробное расписание всех путей.
Начиная с надписи:
Код
Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Макрос1"
Рекомендовал бы запись:
Код
Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Module1.Макрос1"
Так же исключить все: (Что вообще недопустимо в таких кодах)
Код
SendKeys ("{ }")
Пересмотреть запуск вот таких макросов
Код
Call макрос1
Так как если в другой книге имеется такой же макрос, то он может сработать. При этом надо указать точный путь запуска исполняемого макроса, например так
Код
Module1.Макрос1
Ну, и желательно отловить ошибку. На какой именно строчке встречается и понять на что именно ругается.
Никаких врагов, зато и никаких друзей.
Страницы: 1
Читают тему (гостей: 1)
Наверх