Приостановить работу скрипта VBA при обновлении ссылок - PullRequest
Новая
       10

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

0 голосов
/ 05 января 2019

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

Сценарий: У меня около 20 вложенных таблиц со ссылками на внешние источники. Количество ссылок в таблице варьируется от 500 до 10000. Основная таблица вызывает макросы, чтобы по очереди открывать каждую вложенную таблицу и обновлять ссылки. У каждой электронной таблицы есть панель, которая сообщает мне, сколько ссылок осталось обновить. Это делается путем подсчета количества значений «N / A» в каждой вкладке, а затем суммирования этих значений в ячейке 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 остается на своем первоначальном значении.

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

1 Ответ

0 голосов
/ 06 января 2019

Привет код ниже работал для меня. Попробуйте использовать тот же метод вместо цикла. Расписание будет срабатывать каждую секунду, пока 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
...