我写了一段短代码,从各种临时工作簿中复制图表并将它们合并到一个单独的文件中。
下面显示的实际操作过程运行良好,并且按预期方式生成了结果文件。 但是,当Excel崩溃时,尝试关闭工作簿(workbook.close)或将结果文件(workbook.save)保存到最后时,我遇到了问题。
我已将DoEvents放置在每个语句的任何一侧,以试图使excel赶上自己,但无济于事!
我也尝试过禁用COM加载项,但这似乎没有帮助。
关于为什么会崩溃的任何想法?
非常感谢您!
Sub CompareResults()
Dim wkbAll As Workbook
Dim FilesToOpen
Dim x As Integer
Dim wkbTemp As Workbook
Dim wkbAllname As Variant
Dim wkbfirst As Workbook
Dim nofiles As Integer
Dim seriesname As String
'Create the new workbook
Workbooks.Add
Set wkbAll = ActiveWorkbook
'Select which files to merge
FilesToOpen = Application.GetOpenFilename(fileFilter:="Excel Files (*.xlsx), *.xlsx", MultiSelect:=True, Title:="Arbin Results Files")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
End If
'How many files?
nofiles = UBound(FilesToOpen)
'Set up the first graphs
Set wkbfirst = Workbooks.Open(filename:=FilesToOpen(1))
Set wkbfirst = ActiveWorkbook
ActiveSheet.Shapes.Range(Array("ESR", "GravCap", "VolCap", "ActGravCap", "CapRet", "DisTime")).Select
Selection.Copy
wkbAll.Activate
Range("A1").Select
ActiveSheet.Paste
'Copy each set of graphs to wkball
x = 2
While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(filename:=FilesToOpen(x))
Set wkbTemp = ActiveWorkbook
Set wkbTemp = wkbTemp
wkbTemp.Activate
'Copy ESR Graph
ActiveSheet.ChartObjects("ESR").Activate
ActiveChart.ChartArea.Copy
wkbAll.Activate
ActiveSheet.ChartObjects("ESR").Activate
ActiveChart.Paste
wkbTemp.Activate
'Copy GravCap Graph
ActiveSheet.ChartObjects("GravCap").Activate
ActiveChart.ChartArea.Copy
wkbAll.Activate
ActiveSheet.ChartObjects("GravCap").Activate
ActiveChart.Paste
wkbTemp.Activate
'Copy ActGrav Graph
ActiveSheet.ChartObjects("ActGravCap").Activate
ActiveChart.ChartArea.Copy
wkbAll.Activate
ActiveSheet.ChartObjects("ActGravCap").Activate
ActiveChart.Paste
wkbTemp.Activate
'Copy VolCap Graph
ActiveSheet.ChartObjects("VolCap").Activate
ActiveChart.ChartArea.Copy
wkbAll.Activate
ActiveSheet.ChartObjects("VolCap").Activate
ActiveChart.Paste
wkbTemp.Activate
'Copy CapRet Graph
ActiveSheet.ChartObjects("CapRet").Activate
ActiveChart.ChartArea.Copy
wkbAll.Activate
ActiveSheet.ChartObjects("CapRet").Activate
ActiveChart.Paste
wkbTemp.Activate
'Copy DisTime Graph
ActiveSheet.ChartObjects("DisTime").Activate
ActiveChart.ChartArea.Copy
wkbAll.Activate
ActiveSheet.ChartObjects("DisTime").Activate
ActiveChart.Paste
DoEvents
wkbTemp.Close (False)
DoEvents
x = x + 1
Wend
DoEvents
'Save the merged File
wkbAllname = Application.GetSaveAsFilename("merged", fileFilter:="microsoft
excel files (*.xlsx), *.xlsx")
If wkbAllname <> False Then
MsgBox "File Saved as " & wkbAllname
Else: End
End If
DoEvents
wkbAll.SaveAs wkbAllname
DoEvents
End Sub