在多个excel工作簿中按顺序运行多个宏 - vba

2 回答

• 1

  我没有你的宏所以我创建了虚拟宏，为每个工作簿的每个工作表（包含宏的工作簿除外）的立即窗口输出一些值 .

  您的代码似乎依赖于激活每个工作表的输出宏 . 这是不好的做法 . 我将工作簿和工作表名称传递给宏 . 我输出单元格A1的值（ .Cells(1, 1).Value ）以显示它是如何完成的 .

  我希望这足以让你开始 . 询问是否有任何不清楚的地方 .

  Option Explicit
  Sub ControlCall()
  
    Dim FileNameCrnt As String
    Dim InxWSheet As Long
    Dim MsgErr As String
    Dim PathCrnt As String
    Dim RowReportCrnt As Long
    Dim WBookCtrl As Workbook
    Dim WBookOther As Workbook
    Dim WSheetNameOtherCrnt As String
  
    If Workbooks.Count > 1 Then
      ' It is easy to get into a muddle if there are multiple workbooks
      ' open at the start of a macro like this.  Avoid the problem.
      Call MsgBox("Please close all other workbooks " & _
                  "before running this macro", vbOKOnly)
      Exit Sub
    End If
  
    Application.ScreenUpdating = False
  
    Set WBookCtrl = ActiveWorkbook
  
    ' Assume all the workbooks to be processed are in the
    ' same folder as the workbook containing this macro.
    PathCrnt = WBookCtrl.Path
  
    ' Add a slash at the end of the path if needed.
    If Right(PathCrnt, 1) <> "\" Then
      PathCrnt = PathCrnt & "\"
    End If
  
    FileNameCrnt = Dir$(PathCrnt & "*.xl*")
  
    Do While FileNameCrnt <> ""
  
      If FileNameCrnt <> WBookCtrl.Name Then
        ' Consider all workbooks except the one containing this macro
        Set WBookOther = Workbooks.Open(PathCrnt & FileNameCrnt)
  
        For InxWSheet = 1 To WBookOther.Worksheets.Count
          WSheetNameOtherCrnt = WBookOther.Worksheets(InxWSheet).Name
  
          Call macro_1(WBookOther, WSheetNameOtherCrnt)
          Call macro_2(WBookOther, WSheetNameOtherCrnt)
          Call macro_3(WBookOther, WSheetNameOtherCrnt)
          Call macro_4(WBookOther, WSheetNameOtherCrnt)
          Call macro_5(WBookOther, WSheetNameOtherCrnt)
          Call macro_6(WBookOther, WSheetNameOtherCrnt)
        Next
        WBookOther.Close SaveChanges:=False
      End If
   FileNameCrnt = Dir$()
  Loop
  
  Application.ScreenUpdating = True
  
  End Sub
  Sub macro_1(WBookOther As Workbook, WSheetNameOtherCrnt As String)
  
    With WBookOther
      With .Worksheets(WSheetNameOtherCrnt)
        Debug.Print "1 " & WBookOther.Name & " " & _
                    WSheetNameOtherCrnt & " " & .Cells(1, 1).Value
      End With
    End With
  
  End Sub
  Sub macro_2(WBookOther As Workbook, WSheetNameOtherCrnt As String)
  
    With WBookOther
      With .Worksheets(WSheetNameOtherCrnt)
        Debug.Print "2 " & WBookOther.Name & " " & _
                    WSheetNameOtherCrnt & " " & .Cells(1, 1).Value
      End With
    End With
  
  End Sub
  Sub macro_3(WBookOther As Workbook, WSheetNameOtherCrnt As String)
  
    With WBookOther
      With .Worksheets(WSheetNameOtherCrnt)
        Debug.Print "3 " & WBookOther.Name & " " & _
                    WSheetNameOtherCrnt & " " & .Cells(1, 1).Value
      End With
    End With
  
  End Sub
  Sub macro_4(WBookOther As Workbook, WSheetNameOtherCrnt As String)
  
    With WBookOther
      With .Worksheets(WSheetNameOtherCrnt)
        Debug.Print "4 " & WBookOther.Name & " " & _
                    WSheetNameOtherCrnt & " " & .Cells(1, 1).Value
      End With
    End With
  
  End Sub
  Sub macro_5(WBookOther As Workbook, WSheetNameOtherCrnt As String)
  
    With WBookOther
      With .Worksheets(WSheetNameOtherCrnt)
        Debug.Print "5 " & WBookOther.Name & " " & _
                    WSheetNameOtherCrnt & " " & .Cells(1, 1).Value
      End With
    End With
  
  End Sub
  Sub macro_6(WBookOther As Workbook, WSheetNameOtherCrnt As String)
  
    With WBookOther
      With .Worksheets(WSheetNameOtherCrnt)
        Debug.Print "6 " & WBookOther.Name & " " & _
                    WSheetNameOtherCrnt & " " & .Cells(1, 1).Value
      End With
    End With
  
  End Sub
  

  回复于 2024-04-29T20:37:24+08:00
• 4

  伪码大纲：

  For each file in folder  ' I'd use the FileSystemObject for this
      Set wb = Workbooks.Open file 
      For Each sh in wb.worksheets
          ....
      Next
      wb.save
      wb.close
  Next
  

  回复于 2024-04-29T20:37:24+08:00