Макрос RefreshAll сохраняет / закрывает до завершения данных refre sh. Обнуляет данные - PullRequest
0 голосов
/ 30 января 2020

При попытке автоматизировать ручное обновление 8 различных панелей Excel у меня возникла неприятная проблема. Эти инструментальные панели построены с помощью Power Query (16 различных запросов) и Power Pivot и заполнены множеством формул CubeValue, например:

=IFERROR(CUBEVALUE("ThisWorkbookDataModel","[Measures].["&$B$1&"]","[Data].[Geography].&["&$B9&"]","[Data].[Period].&["&$B$3&"]","[Data].[Product].&["&C$3&"]"),"-")

Обычно процесс заключается в открытии старого вручную файла, нажмите «RefreshAll», а затем «Сохранить как» с новым именем.

Макрос работает вроде бы нормально, но когда вы открываете обновленный файл макроса, все ячейки обнуляются (или, скорее, содержат «-» из оператора ошибки).

Если я закомментирую строку закрытия в приведенном ниже коде, Рабочая тетрадь правильно обновит sh, поэтому кажется, что макрос закрывается, прежде чем сможет полностью обновить sh.

I попробовал ответить на вопрос ниже, но безрезультатно.

Подождите, пока ActiveWorkbook.RefreshAll завершится - VBA

Set thiswb = Workbooks("AMPS_Update_Template.xlsm")

sourcepath = "..."
workpath = "..."
savepath = "..."

'*** Define File Name Strings ***
mon = thiswb.Worksheets("Sheet1").Range("D8").Value
we = thiswb.Worksheets("Sheet1").Range("D6").Value

endstring = "_" & mon & "." & we
amps = "AMPS_"
ext = ".xlsb"


'*** BU Array ***
bus = Array("CRMRS", "WHTNRS", "RTD", "PBB", "PD", "SS", "FRZ", "YOG")

'*** Check and Refresh Loop ***
For i = 0 To 7

    If thiswb.Worksheets("Sheet1").CheckBoxes(bus(i)).Value <> 1 Then

        GoTo Line1

    ElseIf thiswb.Worksheets("Sheet1").CheckBoxes(bus(i)).Value = 1 Then

        Application.DisplayAlerts = False

        Workbooks.Open Filename:=savepath & amps & bus(i) & endstring & ext

        DoEvents

        Set wb = Workbooks(amps & bus(i) & endstring & ext)

        wb.RefreshAll

        DoEvents

        wb.SaveAs Filename:=savepath & amps & bus(i) & endstring & ext

        wb.Save

        wb.Close

        Application.DisplayAlerts = True


    End If

Line1:
    Next i

End Sub
...