Приостановить сценарий VBA при обновлении ссылок

Это мой второй пост про этот макрос. Хотя первый пост получил несколько ответов, ни один из ответов не решил проблему (хотя спасибо за ответ).

Сценарий: у меня есть около 20 подтаблиц со ссылками на внешние источники. Количество ссылок на таблицу варьируется от 500 до 10 000. Основная электронная таблица вызывает макросы для открытия каждой подчиненной электронной таблицы по очереди и обновления ссылок. В каждой подтаблице есть панель инструментов, которая сообщает мне, сколько ссылок осталось обновить. Это делается путем подсчета количества значений «Н/Д» на каждой вкладке, а затем суммирования этих значений в ячейке A20. По мере обновления ссылок значение в A20 уменьшается до нуля.

Sub Sub01()
    Dim NAtotal As Integer

    Set ActiveWKB = Workbooks.Open("Sub01.xlsm")

    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Application.CalculateFull
    ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources

    NAtotal = Worksheets("Dashboard").Cells(20, "C").Value
    MsgBox (NAtotal)    'Tells me how many cells remain to be updated – starts off at 4450.

    NAtotal = 100   'Debugging effort to let me know that NAtotal does adjust.
    MsgBox (NAtotal)

    Do Until NAtotal = 0
       Application.ScreenUpdating = True
       MsgBox (NAtotal) 'Another debugging effort to monitor NAtotal. Starts at 100, then jumps to (and remains at) 4450 on the second loop and all subsequent loops.

       NAtotal = Worksheets("Dashboard").Cells(20, "C").Value   'Resets NAtotal to the value in C20. This never changes, but remains at 4450.

       DoEvents

    Loop

    Application.Calculation = xlManual
    MsgBox ("Done")

    Sheets("Dashboard").Activate
    Range("B1").Select

    ActiveWorkbook.Save
    ActiveWindow.Close

End Sub`

Макрос должен продолжать цикл до тех пор, пока ячейка A20 не достигнет нуля, а затем остановится. Ячейка A20 ведет обратный отсчет, но переменная NAtotal остается в исходном значении.

Любые рекомендации/рекомендации приветствуются.


excel vba pause
person Steve    schedule 05.01.2019    source источник
comment
Привет, я думаю, что видел подобную проблему раньше, но не уверен, что это то же самое. Я считаю, что это связано с Workbooks.open, который вызывает проблему. Вы пытались выполнить ту же процедуру в одной из вспомогательных таблиц, не открывая ее через основную таблицу? Попробуйте, и если значение обновится, моя теория может оказаться верной.   -  person RCL    schedule 06.01.2019
comment
Спасибо за ваше предложение RCL. Я скопировал и отредактировал код с мастера на саб, и запустил макрос с уже открытым сабом, результат тот же. Я прокомментировал все, начиная с цикла «До» до конца, и все прошло нормально — экран обновился с правильными подсчетами. Вид побеждает цель, поскольку я хочу связать серию макросов вместе, чтобы последовательно обновлять все подтаблицы.   -  person Steve    schedule 06.01.2019

Ответы (1)


arrow_upward
1
arrow_downward

Привет, приведенный ниже код работал у меня. Попробуйте использовать тот же метод вместо использования цикла. Расписание будет срабатывать каждую секунду до тех пор, пока NATotal не станет логически равным 0. Просто обновите код, чтобы он соответствовал вашим ссылкам.

Public firstOpen As Boolean

Sub testForm()
Dim cellCount As Integer
Dim s1 As Sheet1
Set s1 = Sheet1
Dim cellCol As Integer
Dim activeWbk As Workbook
Dim ws As Worksheet

If firstOpen = False Then
 firstOpen = True
 Set activeWbk = Workbooks.Open("C:\Example\Link2.xlsm")
 Set ws = activeWbk.Sheets("Sheet1")
 Application.Calculation = xlCalculationAutomatic
 Application.CalculateFull
 activeWbk.UpdateLink Name:=ActiveWorkbook.LinkSources
 CreateNewSchedule
 Exit Sub
Else
 Set activeWbk = Workbooks("Link2.xlsm")
 Set ws = activeWbk.Worksheets("Sheet1")
End If


cellCount = ws.Range("N2").Value



If cellCount = 0 Then
 MsgBox ("Done...")
 Application.Calculation = xlCalculationManual
 firstOpen = false 
Else
  Debug.Print cellCount
  CreateNewSchedule

End If

'Application.Calculation = xlCalculationManual

End Sub

Sub CreateNewSchedule()
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="testForm", Schedule:=True
End Sub
person RCL    schedule 06.01.2019