Question

我一直收到这个1004运行时错误。我已经缩减了我的编程，所以它不是那么Programception。我认为这可能与使用Excel 2010保存.xls文件有关。不确定。

当Auto_Root.xls打开时，它会运行Sub auto_open（）打开 Panel.xls
面板打开并运行Sub Update（），按顺序打开7个文件在不同的目录中都称为Auto_Update.xls
Auto_Update.xsl打开并运行Sub Flat，每个都打开一些顺序存档文件并将自己的平面副本保存在另一个文件中目录。

我已经打开了7个Auto_Update.xls文件中的每一个并且已经独立运行它们并且它们运行时没有错误。当我从Auto_Root运行它们时，我得到一个运行时错误1004.并且其中一个文件突出显示CurrentWB.Save。我甚至将CurrentWB.Save替换为CurrentWB.SaveAs Filename：= TargetFile，FileFormat：= xlNormal并收到相同的运行时错误。

附上我的代码。

AutoRoot.xls！自动更新

Sub auto_open()
Application.CutCopyMode = False
Dim PanelFilePath As String
Dim PanelFileName As String
Dim PanelLocation As String
Dim PanelWB As Workbook
    PanelFilePath = "D:\umc\UMC Production Files\Automation Files\"
    PanelFileName = "Panel.xls"
    PanelLocation = PanelFilePath & Dir$(PanelFilePath & PanelFileName)
        Set PanelWB = Workbooks.Open(Filename:=PanelLocation, UpdateLinks:=3)
            PanelWB.RunAutoMacros Which:=xlAutoOpen
            Application.Run "Panel.xls!Update"
            PanelWB.Close
    Call Shell("D:\umc\UMC Production Files\Automation Files\Auto.bat", vbNormalFocus)
Application.Quit
End Sub

Panel.xls！更新

 Sub Update()
Dim RowNumber As Long
Dim AutoUpdateTargetFile As String
Dim AutoUpdateWB As Workbook
For RowNumber = 1 To (Range("AutoUpdate.File").Rows.Count - 1)
    If (Range("AutoUpdate.File").Rows(RowNumber) <> "") Then
        AutoUpdateTargetFile = Range("Sys.Path") & Range("Client.Path").Rows(RowNumber) & Range("AutoUpdate.Path ").Rows(RowNumber) & Range("AutoUpdate.File").Rows(RowNumber)
        Set AutoUpdateWB = Workbooks.Open(Filename:=AutoUpdateTargetFile, UpdateLinks:=3)
            AutoUpdateWB.RunAutoMacros Which:=xlAutoOpen
            Application.Run "Auto_Update.xls!Flat"
            AutoUpdateWB.Close
    End If
    Next RowNumber
End Sub

AutoUpdate.xls！平

Sub Flat()
Dim RowNumber As Long 'Long Stores Variable
Dim SheetNumber As Long
Dim TargetFile As String 'String Stores File Path
Dim BackupFile As String
Dim CurrentWB As Workbook 'Workbook Stores Workbook
For RowNumber = 1 To (Range("File").Rows.Count - 1)
'Loops through each file in the list and assigns a workbook variable.
    If (Range("File").Rows(RowNumber) <> "") Then
        TargetFile = Range("Sys.Path") & Range("Path").Rows(RowNumber) & Range("File").Rows(RowNumber) 'Target File Path
        BackupFile = Range("Report.Path") & Range("Path").Rows(RowNumber) & Range("SubFolder") & Range("File").Rows(RowNumber) 'Backup File Path
Set CurrentWB = Workbooks.Open(Filename:=TargetFile, UpdateLinks:=3) 'Sets CurrentWB = to that long name. This becomes the name of the workbook.
    CurrentWB.RunAutoMacros Which:=xlAutoOpen 'Enables Macros in Workbook
    CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=56
        For SheetNumber = 1 To Sheets.Count 'Counts Worksheets in Workbook
            Sheets(SheetNumber).Select 'Selects All Worksheets in Workbook
            If (Sheets(SheetNumber).Name <> "What If") Then
                Sheets(SheetNumber).Unprotect ("UMC626") 'Unprotects Workbook
                Cells.Select 'Selects Data in Workbook
                Range("B2").Activate
                With Sheets(SheetNumber).UsedRange
                    .Value = .Value
                End With
                Sheets(SheetNumber).Protect Password:="UMC626", DrawingObjects:=True, Contents:=True, Scenarios:=True 'Protects Workbook
            End If
        Next SheetNumber 'Runs Through Iteration
        Sheets(1).Select
        Range("A1").Select 'Saves each workbook at the top of the page
        CurrentWB.SaveAs Filename:=BackupFile, FileFormat:=56, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False 'Saves Workbook in Flatten File Location
    CurrentWB.Close 'Closes Workbook
    End If 'Ends Loop
Next RowNumber 'Selects Another Account
End Sub

到目前为止我做了什么。

每个单独的AutoUpdate文件在运行时都有效。
如果Application.Run＆＃34; Auto_Update.xls！Flat＆＃34;从Panel.xls中删除！更新它会打开并关闭所有AutoUpdate.xls文件，没有错误。
如果我将Panel.xls！Update链接到7个AutoUpdate文件中的3个....任何3.它运行时没有错误。

我似乎无法在不说运行时错误1004的情况下运行所有7个。

我发现微软可以解决代码问题。不知道如何实现它。

Sub CopySheetTest()
    Dim iTemp As Integer
    Dim oBook As Workbook
    Dim iCounter As Integer

    ' Create a new blank workbook:
    iTemp = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set oBook = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = iTemp

    ' Add a defined name to the workbook
    ' that RefersTo a range:
    oBook.Names.Add Name:="tempRange", _
        RefersTo:="=Sheet1!$A$1"

    ' Save the workbook:
    oBook.SaveAs "c:\test2.xls"

    ' Copy the sheet in a loop. Eventually,
    ' you get error 1004: Copy Method of
    ' Worksheet class failed.
    For iCounter = 1 To 275
        oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
        'Uncomment this code for the workaround:
        'Save, close, and reopen after every 100 iterations:
        If iCounter Mod 100 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("c:\test2.xls")
        End If
    Next
End Sub

http://support.microsoft.com/kb/210684/en-us

Answer 1

根据以下链接的Microsoft文档，这是一个已知问题。

Copying worksheet programmatically causes run-time error 1004 in Excel

我不确定这个循环平板有多少张，但似乎是问题。特别是引用：

当您为工作簿提供已定义的名称，然后多次复制工作表而不先保存并关闭工作簿时，可能会发生此问题

由于您使用单独的工作簿创建的级别，我建议从限制Update子例程的范围开始。对于类似的东西有很多设计，但我可能首先将整数参数传递回来，然后在自动打开和更新之间传递第四个。这样你就可以多次关闭并重新打开Panel.xls，并从你离开的地方开始。

Answer 2

从你的文字中不清楚，但是你正在打开的文件里面是“平坦”的程序，如果是这样，它是由自动打开的宏调用的吗？听起来您只想从原始工作簿中运行宏，而不是在打开的工作簿的自动打开宏中触发宏。如果确实如此，我会在我的一个工作簿中执行类似的操作，我会在工作簿打开时触发“升级”向导，但是因为我正在升级，我打开的其他工作簿也有升级向导，以及以前用于开火的。我通过在隐藏的excel实例中打开其他工作簿来解决这个问题，并且在我的自动打开宏中，我有一行代码来查询工作簿的可见状态，如果隐藏它则不会触发。因此，在下面的代码中，“And Me.Application.visible”控制是否运行向导

  'Check if the ODS code is populated or default xxx, if so invoke the upgrade wizard
  'but only if the application is visible
   If (ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value = "xxx" _
        Or Len(ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value) = 0) _
        And Me.Application.visible = True Then
          'run the upgrade wizard
       frmCSCWizardv8.Show
   End If

这要求您在单独的Excel实例中打开工作簿。下面的代码是执行此操作的代码片段，希望这对您有所了解

      Dim lRet
      Dim i As Integer, j As Integer
      Dim FoundSheet As Boolean

      'Because the wizard opens the old DCS in a hidden instance of Excel, it is vital that we close this if
      'anything goes wrong, so belt and braces, close it every time the user presses the button
      'Switch off the error handling and the display alerts to avoid any error messages if the old dcs has
      'never been opened and the hidden instance does not exist
    Application.DisplayAlerts = False
   On Error Resume Next
        book.Close SaveChanges:=False
        app.Quit
        Set app = Nothing
    Application.DisplayAlerts = True

      'set error handling
    On Error GoTo Err_Clr

      'populate the status bar
   Application.StatusBar = "Attempting to open File"

      'Default method Uses Excel Open Dialog To Show the Files
   lRet = Application.GetOpenFilename("Excel files (*.xls;*.xlsx;*.xlsm;*.xlsb), *.xls;*.xlsx;*.xlsm;*.xlsb")

      'If the user selects cancel update the status to tell them
   If lRet = False Then
       Me.lstOpenDCSStatus.AddItem "No file selected"
      'if the user has selected a file try to open it
   Else
          'This next section of code creates a new instance of excel to open the selected file with, as this allows us to
          'open it in the background
       OldDCS = lRet
       Application.StatusBar = "Attempting to open File - " & lRet
       app.visible = False 'Visible is False by default, so this isn't necessary, but makes readability better
       Set book = app.Workbooks.Add(lRet)
       Application.StatusBar = "Opened File - " & lRet

运行宏的宏，打开文件并将其另存为值 - 运行时错误1004

2 个答案: