Макрос, который запускает макрос, который открывает файлы и сохраняет их как значение - ошибка выполнения 1004

Я продолжаю получать эту ошибку времени выполнения 1004. Я уменьшил свою программу, поэтому это не так Programception. Я думаю, что это может быть связано с использованием Excel 2010 для сохранения .xls-файл. Не уверенный.

  1. Когда Auto_Root.xls открывает его запускает Sub auto_open (), который открывается Панель.в XLS
  2. панель открывает и запускает Sub Update (), который последовательно открывает 7 файлов в разных каталогах все называются Auto_Update.в XLS
  3. Auto_Update.xsl открывает и запускает Sub Flat, который каждый открыть несколько файлы последовательно и сохраняет плоскую копию себя в другом справочник.

Я открыл каждый из 7 Auto_Update.xls файлы и запустить их независимо, и они работают без ошибок. Когда я запускаю их все из Auto_Root, я получаю ошибку времени выполнения 1004. И CurrentWB.Сохранить выделено на одном из файлов. Я даже заменил CurrentWB.Сохранить как 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:umcUMC Production FilesAutomation 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:umcUMC Production FilesAutomation FilesAuto.bat", vbNormalFocus)
Application.Quit
End Sub

панель.в XLS!Update

 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

Автообновление.в 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

что я сделал до сих пор.

  1. каждый отдельный файл AutoUpdate работает при запуске на его on.
  2. Если Приложения.Запустить"Auto_Update.в XLS!Плоский " извлекается из панели.в XLS!Обновление открывает и закрывает все AutoUpdate.XLS файлы без ошибок.
  3. Если Я панель ссылок.в XLS!Обновите только 3 из 7 файлов автозапуска.... любые 3. Он работает без ошибок.

Я просто не могу заставить его запустить все 7, не говоря об ошибке выполнения 1004.

Я нашел работу microsoft вокруг кода. Не уверен,как его реализовать.

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"

    ' 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

2 ответов


на основе документа от Microsoft, связанного ниже, это известная проблема.

копирование рабочего листа программно вызывает ошибку времени выполнения 1004 в Excel

Я не уверен, сколько листов этот цикл в квартире, но кажется, что это проблема. В частности, цитата:

эта проблема может возникнуть, если дать книге определенное имя, а затем скопировать лист несколько раз без предварительного сохранения и закрытия книга

из-за уровней, которые вы создали с помощью отдельных книг, я бы предложил начать с ограничения области вашей подпрограммы обновления. Есть много проектов для чего-то подобного, но я мог бы начать с передачи целочисленного аргумента назад и четвертого между Auto Open и Update. Таким образом, Вы можете закрыть и снова открыть Панель.xls несколько раз и начать именно там,где вы остановились.


это не ясно из вашего текста, но ваша процедура "плоская" внутри файлов, которые вы открываете, и если да, то она вызывается макросом auto open? Похоже, вы хотите запускать макрос только из исходной книги, а не запускать макрос в автоматически открытом макро открываемых книг. Если это действительно так, я делаю что - то подобное в одной из моих книг, где у меня есть мастер" обновления", который срабатывает при открытии рабочей книги, однако, поскольку я обновляю, другая книга, которую я открываю, также имеет мастер обновления, и поэтому она также используется для запуска. Я решил это, открыв другую книгу в скрытом экземпляре excel, и в моем макро auto open у меня есть строка кода, которая запрашивает видимое состояние книги и не срабатывает, если она скрыта. Поэтому в приведенном ниже коде это "и я".Приложение.видимый", который управляет запуском мастера

  '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. Этот ниже кода приведен фрагмент кода, который делает это, надеюсь, что это enopugh для вас, чтобы получить идею

      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