Здравствуйте форумчане.
Запускаю макрос в одной книге, он автоматически повторяется через каждые 10 секунд (Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Макрос1")
до выполнения определенного условия.
Если при выполнении этого макроса работать в этой или в другой книге, с активацией ячеек и ввода в них данных, бывает возникает ошибка.
Запускаю макрос в одной книге, он автоматически повторяется через каждые 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 |