工作簿变得损坏，并在macros保存一定数量的表后不会打开
在一个Excel实例（实例A）中，我的工作簿（工作簿A）根据用户input执行计算，并创build一个包含图表对象的工作表。 此工作表被复制并粘贴到另一个工作簿（工作簿B）中，该工作簿在实例A中closures，然后在另一个Excel实例（实例B）中打开。 工作簿B /实例B保持打开并在单独的窗口中，因为工作簿A /实例A的function是创build要在工作簿B /实例B中查看的工作表。
因此macros过程是：工作表在实例A /工作簿A中创build – >工作簿B在实例B中closures – >工作簿B在实例A中打开 – >工作表从工作簿A复制到工作簿B – >工作簿B被保存/在实例A中closures – >在实例B中打开工作簿B.
为了充分披露，这是整个子：
Sub CopySSToNewWorkbook() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Dim MoveFromWkb As Workbook Dim MoveFromSht As Worksheet Dim ChartName As String Dim RngToCover As Range Dim duplicateChtPic As Shape Dim NewSheetName As String Dim TagString As String If InputPage.Range("PanelTag") <> "" Then TagString = "-" & InputPage.Range("PanelTag").Text Set MoveFromWkb = ThisWorkbook 'Set MoveFromSht = MoveFromWkb.Sheets("InputPage") If InputPage.Range("PgNum") <> "" Then NewSheetName = InputPage.Range("RoomNum").Text & TagString & " (Pg" & InputPage.Range("PgNum") & ")" Set MoveFromSht = MoveFromWkb.Worksheets(NewSheetName) Else NewSheetName = InputPage.Range("RoomNum").Text & TagString Set MoveFromSht = MoveFromWkb.Worksheets(NewSheetName) End If Set RngToCover = MoveFromSht.Range("E19:Y34") ChartName = "Panel" & InputPage.Range("PgNum") 'Duplicate method Set duplicateChtPic = MoveFromSht.ChartObjects(ChartName).Duplicate() MoveFromSht.Shapes(ChartName).Delete duplicateChtPic.ZOrder msoSendToBack duplicateChtPic.Select Call DelinkChartFromData With duplicateChtPic .height = RngToCover.height ' resize .Width = RngToCover.Width ' resize .top = RngToCover.top - 2 ' reposition .Left = RngToCover.Left - 6 ' reposition End With MoveFromSht.Shapes("SaveSpoolSheetButton").Delete MoveFromSht.Shapes("EditSpoolSheetButton").Visible = msoTrue MoveFromSht.Shapes("UpdatePageNumberButton").Visible = msoTrue MoveFromSht.Shapes("DeletePanelButton").Visible = msoTrue Dim CNumber As String Dim RelNum As String Dim CrtNum As String Dim Percentage As String Dim SSFolderName As String Dim Wkbname As String Dim FileLocation As String Dim Sht As Worksheet Dim SSCopyYesNo As Integer Dim DoubleSheet As Boolean Dim MoveToWkb As Workbook Dim MoveToSht As Worksheet Dim PasteSheet As Worksheet Dim CellName As name Dim SheetCounter As Integer SheetCounter = 1 Dim i As Integer Dim varLinks As Variant With InputPage CNumber = .Range("JNumber").Text CrtNum = "Crt" & .Range("CrateNum").Text RelNum = "Rel" & .Range("RelNum").Text Percentage = (.Range("RelPct").value * 100) & "Pct" End With If CNumber <> "" Then Wkbname = Wkbname & CNumber End If If RelNum <> "Rel" Then Wkbname = Wkbname & "_" & RelNum End If If CrtNum <> "Crt" Then Wkbname = Wkbname & "_" & CrtNum End If If Percentage <> "0Pct" Then Wkbname = Wkbname & "_" & Percentage End If SSFolderName = CreateSSFolders FileLocation = SSFolderName & "\" & Wkbname & ".xlsb" Dim newXL As Excel.Application 'Set newXL = GetObject(FileLocation).Application If IsFileOpen(FileLocation) = True Then Set newXL = GetObject(FileLocation).Application newXL.Application.ScreenUpdating = False newXL.DisplayAlerts = False newXL.Application.Workbooks(Wkbname & ".xlsb").Close SaveChanges:=False ' newXL.Application.Quit ' Set newXL = Nothing Else Set newXL = CreateObject("Excel.Application") newXL.Visible = True End If If FileFolderExists(FileLocation) Then ' newXL.Application.ScreenUpdating = False ' newXL.Application.DisplayAlerts = False ' On Error Resume Next ' newXL.Workbooks(Wkbname & ".xlsb").Close SaveChanges:=False ' On Error GoTo 0 Workbooks.Open FileLocation, UpdateLinks:=False, ReadOnly:=False Set MoveToWkb = Workbooks(Wkbname & ".xlsb") Else Workbooks.Open (InputPage.MainFolderLocation.Text & "calc_and_trans\SpoolSheetWorkbookTemplate.xlsb") Set MoveToWkb = Workbooks("SpoolSheetWorkbookTemplate.xlsb") 'if SSFolder doesn't already exist, the EditSpoolSheet module is imported to the new spoolsheet 'it is also exported to update any changes made If FileFolderExists(InputPage.MainFolderLocation.Text & "calc_and_trans\ExportModules\EditSpoolSheet.bas") Then 'change path for home MoveFromWkb.VBProject.VBComponents("EditSpoolSheet").export InputPage.MainFolderLocation.Text & "calc_and_trans\ExportModules\EditSpoolSheet.bas" 'change path for home MoveToWkb.VBProject.VBComponents.Import InputPage.MainFolderLocation.Text & "calc_and_trans\ExportModules\EditSpoolSheet.bas" 'change path for home Else MoveFromSht.Shapes("EditSpoolSheetButton").Visible = msoFalse MoveFromSht.Shapes("UpdatePageNumberButton").Visible = msoFalse MoveFromSht.Shapes("CancelEditButton").Visible = msoFalse MoveFromSht.Shapes("DeletePanelButton").Visible = msoFalse End If End If For Each CellName In MoveToWkb.Names If Right(CellName.name, 10) <> "Print_Area" Then CellName.Delete End If Next Dim NewPgNum As String Dim OldPgNum As String Dim startRead As Integer Dim continueRun As Boolean continueRun = False NewPgNum = InputPage.Range("PgNum") For Each Sht In MoveToWkb.Worksheets startRead = InStr(Sht.name, "(Pg") If Mid(Sht.name, startRead + 3) = (Right(MoveFromSht.name, Len(NewPgNum) + 1)) And DoubleSheet = False Then DoubleSheet = True Application.ScreenUpdating = True SSCopyYesNo = MsgBox("Do you want to overwrite " & Sht.name & "?", vbYesNo + vbQuestion) Application.ScreenUpdating = False If SSCopyYesNo = vbYes Then Dim spoolPosition As Integer spoolPosition = Sht.Index Sht.name = "_" 'attaching a macro to the edit spool sheet button If FileFolderExists(InputPage.MainFolderLocation.Text & "calc_and_trans\ExportModules\EditSpoolSheet.bas") Then 'change path for home MoveFromSht.Shapes("EditSpoolSheetButton").OnAction = "EditSpoolSheetClicked" MoveFromSht.Shapes("UpdatePageNumberButton").OnAction = "UpdatePageNumberClicked" MoveFromSht.Shapes("CancelEditButton").OnAction = "CancelEditButtonClicked" MoveFromSht.Shapes("DeletePanelButton").OnAction = "DeletePanelButtonClicked" End If MoveFromSht.Range("Page_Number") = MoveFromSht.Range("AK21") MoveFromSht.Copy After:=MoveToWkb.Sheets(spoolPosition) Application.DisplayAlerts = False Sht.Delete Application.CutCopyMode = False continueRun = True End If ElseIf DoubleSheet <> True Then DoubleSheet = False End If SheetCounter = SheetCounter + 1 Next If DoubleSheet = False Then Set PasteSheet = Workbooks(MoveToWkb.name).Worksheets.Add ' MoveFromSht.Copy before:=MoveToWkb.Sheets(1) 'attaching a macro to the edit spool sheet button If FileFolderExists(InputPage.MainFolderLocation.Text & "calc_and_trans\ExportModules\EditSpoolSheet.bas") Then 'change path for home MoveFromSht.Shapes("EditSpoolSheetButton").OnAction = "EditSpoolSheetClicked" MoveFromSht.Shapes("UpdatePageNumberButton").OnAction = "UpdatePageNumberClicked" MoveFromSht.Shapes("CancelEditButton").OnAction = "CancelEditButtonClicked" MoveFromSht.Shapes("DeletePanelButton").OnAction = "DeletePanelButtonClicked" End If MoveFromSht.Range("Page_Number") = MoveFromSht.Range("AK21") MoveFromSht.Copy After:=MoveToWkb.Sheets(SheetCounter) Application.CutCopyMode = False continueRun = True End If If continueRun Then For Each Sht In MoveToWkb.Worksheets If Mid(Sht.name, 1, 5) = "Sheet" Then Application.DisplayAlerts = False Sht.Delete End If Next Set MoveToSht = MoveToWkb.Sheets(MoveFromSht.name) Dim moveToShtName As String moveToShtName = MoveToSht.name 'fix in here For Each CellName In MoveToWkb.Names If Right(CellName.name, 10) <> "Print_Area" Then Application.DisplayAlerts = False CellName.Delete End If Next Application.PrintCommunication = False MoveToSht.DisplayPageBreaks = False 'For Each Sht In MoveToWkb.Worksheets With MoveToSht.PageSetup .PrintArea = "$A$1:$Z$36" .Orientation = xlLandscape .PaperSize = xlPaperLetter .BlackAndWhite = True .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 .LeftMargin = Application.InchesToPoints(1.6) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .CenterHorizontally = True .CenterVertically = True End With Application.PrintCommunication = True '%%%%%%%%new crate code %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% '******************* Update Crate Sheet Info **************************************' Dim crateSht As Worksheet Dim frontSht As Worksheet Set crateSht = MoveToWkb.Sheets("Crate_List") Set frontSht = MoveToWkb.Sheets("FrontSheet") Dim writeRow As Integer Dim continueToEnd As Boolean Dim roomColumn As Integer, pageColumn As Integer, sizeColumn As Integer, widthColumn As Integer, typeColumn As Integer, tagColumn As Integer Dim infoTableCol As Integer Dim colStep As Integer For colStep = 1 To 15 Select Case crateSht.Cells(1, colStep).Text Case "ROOM #" roomColumn = colStep Case "PAGE #" pageColumn = colStep Case "PANEL SIZE" sizeColumn = colStep Case "PANEL WIDTH" widthColumn = colStep Case "SQFT" infoTableCol = colStep Case "PANEL TYPE" typeColumn = colStep Case "PANEL TAG" tagColumn = colStep End Select Next 'if first spoolsheet being added, set constant values (job name, job number etc.) If MoveToWkb.Sheets.count = 3 Then frontSht.Cells(5, 6) = MoveToSht.Range("AK2") frontSht.Cells(6, 6) = MoveToSht.Range("AK3") Dim EventsState As Boolean EventsState = Application.EnableEvents Application.EnableEvents = False frontSht.Cells(6, 12) = MoveToSht.Range("AK7") Application.EnableEvents = EventsState End If 'determines where to write panel data: if row is blank, if Page # being written and read are both "" and panel tag/room # match, and if page numbers are not "" and match For writeRow = 2 To 500 If Len(crateSht.Range("A" & writeRow).value) = 0 Or (InputPage.Range("PgNum") = "" And crateSht.Cells(writeRow, pageColumn).value = "" And crateSht.Range("A" & writeRow).value = InputPage.Range("RoomNum").value And _ crateSht.Cells(writeRow, tagColumn).value = InputPage.Range("PanelTag").value) Or (InputPage.Range("PgNum").value <> "" And _ InputPage.Range("PgNum").value = crateSht.Cells(writeRow, pageColumn).value) Then 'If continueToEnd Then Exit For End If Next Dim panelCrateData(24) As Variant Dim panelTableData As Variant panelTableData = MoveToSht.Range("AK1:AK39") 'writing spoolsheet information to crate sheet With MoveToSht If roomColumn <> 0 Then crateSht.Cells(writeRow, roomColumn) = panelTableData(22, 1) '.Range("AK22") If pageColumn <> 0 Then crateSht.Cells(writeRow, pageColumn) = panelTableData(21, 1) '.Range("AK21") If sizeColumn <> 0 Then crateSht.Cells(writeRow, sizeColumn) = panelTableData(13, 1) '.Range("AK13") If widthColumn <> 0 Then crateSht.Cells(writeRow, widthColumn) = panelTableData(12, 1) ' .Range("AK12") If tagColumn <> 0 Then crateSht.Cells(writeRow, tagColumn) = panelTableData(24, 1) If typeColumn <> 0 Then crateSht.Cells(writeRow, typeColumn) = panelTableData(23, 1) panelCrateData(0) = Round(CDbl(Replace(.Range("X35").Text, "SQFT", "")), 2) panelCrateData(1) = panelTableData(15, 1) '.Range("AK15") panelCrateData(2) = panelTableData(14, 1) '.Range("AK14") panelCrateData(3) = panelTableData(17, 1) '.Range("AK17") panelCrateData(4) = panelTableData(16, 1) '.Range("AK16") panelCrateData(5) = panelTableData(18, 1) '.Range("AK18") panelCrateData(6) = panelTableData(20, 1) '.Range("AK20") panelCrateData(7) = panelTableData(19, 1) '.Range("AK19") panelCrateData(8) = panelTableData(25, 1) '.Range("AK23") panelCrateData(9) = panelTableData(26, 1) '.Range("AK24") panelCrateData(10) = panelTableData(27, 1) '.Range("AK25") panelCrateData(11) = panelTableData(29, 1) '.Range("AK27") panelCrateData(12) = panelTableData(30, 1) '.Range("AK28") panelCrateData(13) = panelTableData(31, 1) '.Range("AK29") panelCrateData(14) = panelTableData(28, 1) '.Range("AK26") panelCrateData(15) = panelTableData(34, 1) '.Range("AK32") panelCrateData(16) = panelTableData(33, 1) '.Range("AK31") panelCrateData(17) = panelTableData(35, 1) '.Range("AK33") panelCrateData(18) = panelTableData(36, 1) '.Range("AK34") panelCrateData(19) = panelTableData(37, 1) '.Range("AK35") panelCrateData(20) = panelTableData(38, 1) '.Range("AK36") panelCrateData(21) = panelTableData(39, 1) '.Range("AK37") panelCrateData(22) = .Range("AU19") 'Holdback Info panelCrateData(23) = .Range("AU12") panelCrateData(24) = .Range("AU14") 'Additional Saddles crateSht.Range(crateSht.Cells(writeRow, infoTableCol), crateSht.Cells(writeRow, infoTableCol + 24)) = panelCrateData ' "M" & writeRow & ":AK" & writeRow) = panelCrateData End With For writeRow = 2 To 500 If Len(crateSht.Range("A" & writeRow).value) = 0 Then ' Or crateSht.Range("A" & writeRow).value = InputPage.Range("RoomNum").value Then 'If continueToEnd Then Exit For End If Next Dim lastRow As Integer lastRow = writeRow - 1 Dim totSqft As Double totSqft = WorksheetFunction.Sum(crateSht.Range(crateSht.Cells(2, infoTableCol), crateSht.Cells(lastRow, infoTableCol))) '(crateSht 2:M" & lastRow)) Application.PrintCommunication = False With crateSht .PageSetup.PrintArea = "$A$1:$H$" & CStr(lastRow) .PageSetup.PrintTitleRows = "$1:$1" If lastRow = 2 Then .PageSetup.CenterHeader = "#" & MoveToSht.Range("AK3").value .PageSetup.RightFooter = CStr(lastRow - 1) & " PANELS" & vbLf & "TOUCH UP KIT" & vbLf & "INTERCONNECTORS" _ & vbLf & "GLOVES" & vbLf & "T-BAR CLIPS" & vbLf & "INSULATION ON PANEL" .PageSetup.RightHeader = CStr(totSqft) & " SQFT" End With Application.PrintCommunication = True With frontSht .Cells(11, 2) = lastRow - 1 .Cells(30, 2) = totSqft End With MoveToWkb.SaveAs filename:=FileLocation, FileFormat:=50 MoveToWkb.Close False Set MoveToWkb = Nothing '**********************************************************************************' 'Add new entry to recent panels table, unless room number already exists then replace that entry with the current info= Call AddRecentPanelData MoveFromSht.Delete newXL.Application.ScreenUpdating = True newXL.Application.DisplayAlerts = True newXL.Application.AskToUpdateLinks = True Application.Calculation = xlCalculationAutomatic Set MoveFromWkb = Nothing Set MoveFromSht = Nothing Set MoveToSht = Nothing newXL.Workbooks.Open FileLocation ', UpdateLinks:=False ', ReadOnly:=False Set newXL = Nothing Else MoveToWkb.Close SaveChanges:=False Set MoveToWkb = Nothing newXL.Workbooks.Open FileLocation, UpdateLinks:=False, ReadOnly:=False MoveFromSht.Delete Application.Calculation = xlCalculationAutomatic Set newXL = Nothing Set MoveFromWkb = Nothing Set MoveFromSht = Nothing Set MoveToSht = Nothing End If Exit Sub '######################################################################################### ErrorHandler: Dim Msg As String If Err.number <> 0 Or Err.number <> 20 Then Msg = "Error # " & Str(Err.number) & " was generated by " _ & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext End If Call ReactiveUpdating End Sub 因此，工作簿A使用此子文件创build工作簿B /实例B并将工作表保存到它。 问题是，当工作簿A尝试添加第20个工作表（有时是第24或第23个，但始终在此区域中）时，在此行的实例B中打开工作簿B时出现错误（一对从底部向上滚动），导致代码打破：
newXL.Workbooks.Open FileLocation, UpdateLinks:=False, ReadOnly:=False
对象“工作簿”的方法“打开”失败
如果在popup此错误后单击继续，则完成时没有问题，但实例B中的工作簿B已损坏。 此外，如果我点击X来closures它，Excel崩溃，而工作簿B已损坏/无法打开。
奇怪的是，在保存相同数量的工作表（在20-23个工作表之间）之后，它总是会崩溃。 即使在保存19次（就在预期崩溃之前）完全closures了工作簿和实例之后，保存第20张工作表仍然导致崩溃。
这只发生在一个月前，而且发生在我们testing过的所有计算机上。 我们甚至testing了旧版本的工作簿，当然从来没有这个问题，他们都有同样的问题。
请让我知道，如果您可以提供任何帮助或需要更多的细节，任何洞察力，非常感谢！
在尝试改变工作簿的保存/打开过程之后，我设法弄清楚了这个问题。 保存的工作簿（工作簿B）包含一个ActiveX列表框控件对象，摆脱它后，问题就消失了。 希望这可以节省一些人花费我解决它的时间！