Excel在workbook.save或workbook.close期间崩溃

时间:2019-01-16 17:47:26

标签: excel vba

我写了一段短代码,从各种临时工作簿中复制图表并将它们合并到一个单独的文件中。

下面显示的实际操作过程运行良好,并且按预期方式生成了结果文件。 但是,当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

0 个答案:

没有答案