2012-03-25 80 views
0

我有多個Excel工作簿每個代表天的數據,每個工作簿具有代表當天每個事件多張紙..運行,這樣多的宏在多個Excel工作簿 - VBA

我需要按順序運行6個宏橫跨工作簿中的每張工作表,然後轉到下一個工作簿(所有工作簿位於桌面上的同一文件夾中)

此刻,我正在使用此(下面)按順序在所有工作表中運行宏但我很難試圖讓所有的工作簿上運行

Sub RUN_FILL() 
Dim sh As Worksheet 

For Each sh In ThisWorkbook.Worksheets 
sh.Activate 

Call macro_1 
Call macro_2 
Call macro_3 
Call macro_4 
Call macro_5 
Call macro_6 

Next sh 
End Sub 

任何想法如何我可以做到這一點?

+0

所有的工作簿都是最初打開的,還是您想打開/處理/關閉每個工作簿?工作簿的處理順序也是重要的嗎? – 2012-03-25 20:15:30

+0

工作簿都是最初關閉的,除了id從哪個工作簿運行它們以外,工作簿順序無關緊要,只是宏在各個工作表上的運行順序。 – sam 2012-03-25 20:22:40

回答

4

我沒有你的宏,所以我創建了虛擬宏輸出一些值到立即窗口的每一個工作簿中的每個表(除了包含宏工作簿)。

您的代碼似乎取決於激活每個工作表的輸出宏。這是不好的做法。我將工作簿和工作表名稱傳遞給宏。我輸出單元格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 
1

僞代碼大綱:

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 
相關問題