VBA-Excel公式参考 – 计算刷新
这是我以前的post的后续 。 我成功地能够在另一个驱动器上打开一个不同的工作簿，复制范围内的数据作为图片，然后将其粘贴到ThisWorkbook 。我现在.CopyPicture问题是，我使用的.CopyPicture是捕获他们计算的单元格值，所以最终看起来像是一堆＃N #N/A Requesting Data...值。
我已经使用了一些不同的东西来看看我是否可以在复制公式之前计算公式，但看起来电子表格将不会继续计算，直到macros不再运行。
我检查了这个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
我把我的macros分为两个，利用Application.Run和Application.OnTime Now + TimeValue("00:00:05")感谢这篇文章和@cyboashu通知我。 我所经历的是真实的：彭博数据不会刷新，除非macros已经结束，所以你必须把它分成两个macros，第一个刷新数据，第二个执行你想做的事情。
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