Как запустить один и тот же макрос, VBA-код для 30 различных книг Excel?

Question

Я пытался использовать файл .xlsb, чтобы выполнить его во всех разных книгах, но получаю сообщение об ошибке 400, хотя мой макрос работает для этого конкретного файла.Я написал этот простой код для удаления пустых строк и столбцов в книге.

Sub RepeatTask()
    Dim xSh As Worksheet
    Application.ScreenUpdating = False
    For Each xSh In Worksheets
        xSh.Select
        Call task
    Next

    Application.ScreenUpdating = True
End Sub

Sub task()
    Dim LastColumnIndex As Integer
    Dim LastRowIndex As Integer
    Dim RowIndex As Integer
    Dim ColumnIndex As Integer
    Dim UsedRng As Range

    Set UsedRng = ActiveSheet.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    LastColumnIndex = UsedRng.Column - 1 + UsedRng.Columns.Count

    Application.ScreenUpdating = False

    For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(Rows(RowIndex)) = 0 Then
            Rows(RowIndex).Delete
        End If
    Next RowIndex

    For ColumnIndex = LastColumnIndex To 1 Step -1
        If Application.CountA(Columns(ColumnIndex)) = 0 Then
            Columns(ColumnIndex).Delete
        End If
    Next ColumnIndex

    Application.ScreenUpdating = True

End Sub

Answer 1

Способ, которым я мог бы сделать это для нескольких книг Excel, находится здесь:

Sub OpenFiles()
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String

    On Error Resume Next
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If

    If xStrPath = "" Then Exit Sub
    xFile = Dir(xStrPath & "\*.xlsm")
    Do While xFile <> ""
        Workbooks.Open xStrPath & "\" & xFile
        xFile = Dir
    Loop
    Call Optil
    Call SaveAndCloseAllWorkbooks

End Sub

Sub Optil()
Dim book As Workbook, sheet As Worksheet
Application.ScreenUpdating = False

For Each book In Workbooks
    For Each sheet In book.Worksheets
        Task sheet
    Next sheet
Next book
Application.ScreenUpdating = True

End Sub

Sub RepeatTask()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
    Task xSh 'give worksheet as parameter here instead of select!
Next

Application.ScreenUpdating = True
End Sub

Sub Task(Optional ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet
    Dim LastColumnIndex As Long
    Dim LastRowIndex As Long
    Dim RowIndex As Long
    Dim ColumnIndex As Long
    Dim UsedRng As Range

    Set UsedRng = ws.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    LastColumnIndex = UsedRng.Column - 1 + UsedRng.Columns.Count

    Application.ScreenUpdating = False

    For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(ws.Rows(RowIndex)) = 0 Then
            ws.Rows(RowIndex).Delete
        End If
    Next RowIndex

    For ColumnIndex = LastColumnIndex To 1 Step -1
        If Application.CountA(ws.Columns(ColumnIndex)) = 0 Then
            ws.Columns(ColumnIndex).Delete
        End If
    Next ColumnIndex

    Application.ScreenUpdating = True
End Sub

Sub SaveAndCloseAllWorkbooks()
Dim bk As Workbook

For Each bk In Workbooks
    If Not bk Is ThisWorkbook Then
    bk.Close SaveChanges:=True
    End If
 Next bk

'If You want to save and close active workbook too 
'ThisWorkbook.Close SaveChanges:=True 

End Sub

Answer 2

Я рекомендую не использовать .Select вместо того, чтобы дать лист в качестве параметра и указать лист во всех ws.Rows(), ws.Columns() и т. Д.

Если вы зададите параметр Optional, вы можете вернуться кIf ws Is Nothing Then Set ws = ActiveSheet если Task вызывается без параметра.

Sub RepeatTask()
    Dim xSh As Worksheet
    Application.ScreenUpdating = False
    For Each xSh In Worksheets
        Task xSh 'give worksheet as parameter here instead of select!
    Next

    Application.ScreenUpdating = True
End Sub

Sub Task(Optional ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet

    Dim LastColumnIndex As Long
    Dim LastRowIndex As Long
    Dim RowIndex As Long
    Dim ColumnIndex As Long
    Dim UsedRng As Range

    Set UsedRng = ws.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    LastColumnIndex = UsedRng.Column - 1 + UsedRng.Columns.Count

    Application.ScreenUpdating = False

    For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(ws.Rows(RowIndex)) = 0 Then
            ws.Rows(RowIndex).Delete
        End If
    Next RowIndex

    For ColumnIndex = LastColumnIndex To 1 Step -1
        If Application.CountA(ws.Columns(ColumnIndex)) = 0 Then
            ws.Columns(ColumnIndex).Delete
        End If
    Next ColumnIndex

    Application.ScreenUpdating = True
End Sub