Как избежать ошибки времени выполнения -2147221080 (800401a8): ошибка автоматизации? VBA - PullRequest
0 голосов
/ 04 марта 2020

Я написал макрос, цель которого - открыть рабочую книгу и разбить ее на отдельные рабочие книги в соответствии с именами в столбцах. Я делал это много раз с несколькими макросами, но не в этот раз.

l oop останавливается после правильного создания первой книги, потому что я получаю "ошибку времени выполнения -2147221080 (800401a8): автоматизация ошибка "или" Системная ошибка & H800401A8 (-2147221080) ".

Я безуспешно искал решение в целых rnet весь день.

Вот мой код:

Sub Spacchettamento()

Application.ScreenUpdating = False

Dim FoglioMacro As Worksheet
Set FoglioMacro = ThisWorkbook.Sheets("Macro")

Dim FoglioParametri As Worksheet
Set FoglioParametri = ThisWorkbook.Sheets("Parametri")

Dim Percorsi As Worksheet
Set Percorsi = ThisWorkbook.Sheets("Percorsi")

Dim StatisticheFolderName As String
StatisticheFolderName = Percorsi.Range("A2").Value

Dim DialogBoxFileStatistiche As Office.FileDialog
Dim StatisticheFileName As String

Set DialogBoxFileStatistiche = Application.FileDialog(msoFileDialogFilePicker)

With DialogBoxFileStatistiche
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xlsx?", 1
    .Title = "Seleziona file Statistiche"
    .AllowMultiSelect = False

    .InitialFileName = StatisticheFolderName '

    If .Show = True Then
        StatisticheFileName = .SelectedItems(1)
    End If
End With

Dim FileStatistiche As Workbook
Set FileStatistiche = Workbooks.Open(StatisticheFileName)
FileStatistiche.Activate

Dim FoglioTotale As Worksheet
Set FoglioTotale = Sheets(1)
FoglioTotale.Activate

Dim NuovoWorkbook As Workbook
Dim NuovoSheet As Worksheet

Dim PercorsoSalvataggio As String
PercorsoSalvataggio = FoglioParametri.Range("A9").Value

Dim NomeFileAsm As String
NomeFileAsm = FoglioParametri.Range("A13").Value

' here i want to create a list of names from the whole file and then start a loop
UltimaRiga = FoglioTotale.UsedRange.Rows(FoglioTotale.UsedRange.Rows.Count).Row 'find last row
FoglioTotale.AutoFilterMode = False
FoglioTotale.Range("E10:E" & UltimaRiga).Copy
FoglioParametri.Range("M1").PasteSpecial
FoglioParametri.Range("M1").RemoveDuplicates 1, xlYes

Dim i As Integer

For i = 2 To Application.CountA(FoglioParametri.Range("M:M"))

    FoglioTotale.Range("A10:AO" & UltimaRiga).AutoFilter 5, FoglioParametri.Range("M" & i).Value

    Set NuovoWorkbook = Workbooks.Add
    Set NuovoSheet = NuovoWorkbook.Sheets(1)
    ThisWorkbook.Activate
    NuovoSheet.Name = "LENTI SK+STV"

    FoglioTotale.Range("J1:W1").EntireColumn.Ungroup
    FoglioTotale.Range("J1:W1").EntireColumn.Hidden = False
    FoglioTotale.Range("AG1:AI1").EntireColumn.Hidden = False

    UltimaRiga2 = FoglioTotale.UsedRange.Rows(FoglioTotale.UsedRange.Rows.Count).Row
    FoglioTotale.Range("A1:AO" & UltimaRiga2).SpecialCells(xlCellTypeVisible).Copy
    NuovoSheet.Range("A1").PasteSpecial xlPasteFormulas

    FoglioTotale.ShowAllData
    FoglioTotale.Range("A1:AO12").Copy
    NuovoSheet.Range("A1:AO12").PasteSpecial xlPasteFormats

    UltimaRiga3 = NuovoSheet.UsedRange.Rows(NuovoSheet.UsedRange.Rows.Count).Row
    NuovoSheet.Range("A12:AO12").Copy
    NuovoSheet.Range("A13:AO" & UltimaRiga3).PasteSpecial xlPasteFormats

    NuovoSheet.Range("A10:AO" & UltimaRiga2).AutoFilter Field:=34, Criteria1:=""
    NuovoSheet.ShowAllData
    NuovoSheet.Range("A1:AO1").EntireColumn.AutoFit
    NuovoSheet.Activate
    ActiveWorkbook.Windows(1).DisplayGridlines = False
    NuovoSheet.Range("AH1").EntireColumn.Hidden = True
    NuovoSheet.Range("K1:V1").EntireColumn.Group
    NuovoSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

    NuovoWorkbook.SaveAs Filename:=PercorsoSalvataggio & NomeFileAsm & " - " & FoglioParametri.Range("M" & i).Value & ".xlsx"
    NuovoWorkbook.Application.CutCopyMode = False
    NuovoWorkbook.Close False
    FoglioTotale.AutoFilterMode = False

Next i

FoglioParametri.Range("M1").EntireColumn.Delete

FileStatistiche.Application.CutCopyMode = False
FileStatistiche.Close savechanges:=False

MsgBox "Fatto!"

FoglioMacro.Activate

End Sub

Спасибо всем за помощь и время, Лука

1 Ответ

1 голос
/ 04 марта 2020

Догадываюсь, но вы пытаетесь

NuovoSheet.AutoFilterMode = False

после того, как вы уже закрыли книгу:

NuovoWorkbook.Close False

Попробуйте переместить старую строку до вас сохранить как / закрыть.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...