VBA-Excel公式參考 - 計算刷新

Question

這是跟我的previous post。我成功是能夠在不同的驅動器上打開工作簿的不同，在一個範圍內的圖片複製數據，然後將其粘貼在ThisWorkbook我運行到現在。問題是我使用的是.CopyPicture捕捉單元格值，因此它最終看起來像一堆#N/A Requesting Data...值。

我已經使用了一些不同的東西，看看我是否能得到公式複製之前計算，但它似乎是電子表格不會與計算貫徹直到宏不再運行。

我檢查了this post但我不完全確定如何實施if Application.CalculationState is xLdone then loop else wait。任何幫助？

原始代碼：

Dim BBPic As Workbook 
Dim test As Workbook 
Set BBPic = Application.Workbooks.Open("\\OtherDrive\Shared\OtherGroup\DailySheet.xlsx") 
Set test = ThisWorkbook 

BBPic.Sheets("Sheet1").Range("B2:E16").CopyPicture 
test.Sheets("Summary").Range("B64").PasteSpecial 

第一次嘗試：

Dim BBPic As Workbook 
Dim test As Workbook 
Set BBPic = Application.Workbooks.Open("\\OtherDrive\Shared\OtherGroup\DailySheet.xlsx") 
Set test = ThisWorkbook 

BBPic.Sheets("Sheet1").Range("B2:E16").CopyPicture 
Application.Wait (Now + TimeValue("0:01:00")) 
test.Sheets("Summary").Range("B64").PasteSpecial 
Workbooks("DailySheet.xlsx").Close SaveChanges:=False 

第二次嘗試：

Dim BBPic As Workbook 
Dim test As Workbook 
Set BBPic = Application.Workbooks.Open("\\OtherDrive\Shared\OtherGroup\DailySheet.xlsx") 
Set test = ThisWorkbook 

BBPic.Sheets("Sheet1").Range("B2:E16").CopyPicture 
ActiveWorkbook.RefreshAll 
test.Sheets("Summary").Range("B64").PasteSpecial 
Workbooks("DailySheet.xlsx").Close SaveChanges:=False 

最後一次嘗試：

Dim BBPic As Workbook 
Dim test As Workbook 
Set BBPic = Application.Workbooks.Open("\\OtherDrive\Shared\OtherGroup\DailySheet.xlsx") 
Set test = ThisWorkbook 

BBPic.Sheets("Sheet1").Range("B2:E16").CopyPicture 
ActiveSheet.Calculate 
test.Sheets("Summary").Range("B64").PasteSpecial 
Workbooks("DailySheet.xlsx").Close SaveChanges:=False 

編輯：使用Application.CalculationState = xlDone

Dim BBPic As Workbook 
Dim test As Workbook 
Set BBPic = Application.Workbooks.Open("\\OtherDrive\Shared\OtherGroup\DailySheet.xlsx") 
Set test = ThisWorkbook 

BBPic.Sheets("Sheet1").Select 
Do Until Application.CalculationState = xlDone: DoEvents: Loop 

ActiveSheet.Range("B2:E16").CopyPicture 
test.Sheets("Summary").Range("B64").PasteSpecial 
Workbooks("DailySheet.xlsx").Close SaveChanges:=False 

Answer 1

我打破了我的宏一分爲二，利用Application.Run和Application.OnTime Now + TimeValue("00:00:05")感謝this post和@cyboashu告知我第四嘗試。我所經歷的情況是真實的：彭博數據不會刷新，除非宏已經結束，所以你必須把它分解成2個宏，第一次刷新數據，第二次執行你想做的事情。

Sub OpenDailySheet() 
' 
'Macro 
' 

' 

Dim BBPic As Workbook 
Set BBPic = Application.Workbooks.Open("\\OtherDrive\Shared\OtherGroup\DailySheet.xlsx") 
Application.Run "RefreshAllStaticData" 
Application.OnTime Now + TimeValue("00:00:05"), "PasteChart" 


End Sub 

Sub PasteChart() 

Dim test As Workbook 
Set test = ThisWorkbook 

Workbooks("DailySheet.xlsx").Sheets("Sheet1").Range("B2:E16").CopyPicture 
test.Sheets("Summary").Range("B64").PasteSpecial 
Workbooks("DailySheet.xlsx").Close SaveChanges:=False 

End Sub