Question

我的工作是每天制作100个文件。虽然我有一个宏用于此目的，但我必须在保存上一个之后在每个文件上运行宏。

我的问题是如何能够一步一步地在这些打开的工作簿上运行我的宏。当我保存一个时，它会在队列中的另一个上运行。

Answer 1

将以下宏放在“BASE”工作簿中，如Passerby提到的

Sub SO()
    Dim macroList As Object
    Dim workbookName As String
    Dim wbFullPath
    Dim macroName As String
    Dim currentWb As Workbook
    Dim masterWb As Workbook ' the Excel file you are calling this procedure from
    Dim useWbList As Boolean
    Dim height As Long, i As Long
    Dim dataArray As Variant
    useWbList = False  ' DEFINE which input method
    Set macroList = CreateObject("Scripting.Dictionary")

    If useWbList Then
        ' you can also from the dictionary from 2 columns of an excel file , probably better for management
        With masterWb.Worksheets("Sheet1") '<~~ change Sheet1 to the sheet name storing the data
            height = .Cells(.Rows.Count, 1).End(xlUp).Row ' Assume data in column A,B, starting from row 1
            If height > 1 Then
                ReDim dataArray(1 To height, 1 To 2)
                dataArray = .Range(.Cells(1, 1), .Cells(height, 2)).Value
                For i = 1 To height
                    macroList.Add dataArray(i, 1), dataArray(i, 2)
                Next i
            Else
                'height = 1 case
                macroList.Add .Cells(1, 1).Value, .Cells(1, 2).Value
            End If
        End With
    Else
        ' ENTER THE FULl PATH in 1st agrument below,       Macro Name in 2nd argument
        ' Remember to make sure the macro is PUBLIC, try to put them in Module inside of Sheets'

        macroList.Add "C:\Users\wangCL\Desktop\Book1.xlsm", "ThisWorkbook.testing"
        'macroList.Add "FULL PATH", "MACRO NAME"
        'macroList.Add "FULL PATH", "MACRO NAME"
        'macroList.Add "FULL PATH", "MACRO NAME"
    End If

    Application.DisplayAlerts = False

    For Each wbFullPath In macroList.keys
        On Error GoTo 0
        macroName = macroList.Item(workbookName)
        workbookName = Mid(wbFullPath, InStrRev(wbFullPath, "\") + 1)
        Err.Clear
        On Error Resume Next
        Set currentWb = Nothing
        Set currentWb = Workbooks(workbookName) ' see if the workbook is already open

        If Err.Number <> 0 Then
            ' open the workbook if workbook NOT opened
            Set currentWb = Workbooks.Open(workbookName, ReadOnly:=True)
        End If
        On Error GoTo 0

        ' run the macro
        Application.Run workbookName & "!" & macroList.Item(wbFullPath)


        'close the workbook after running the macro
        currentWb.Close saveChanges:=False
        Set currentWb = Nothing
    Next wbFullPath
End Sub

希望它有所帮助，如果有任何不清楚的地方，请告诉我

Answer 2

我使用下面的代码解决了问题。

Sub OpenAllWorkbooksnew()
        Set destWB = ActiveWorkbook
        Dim DestCell As Range

        Dim cwb As Workbook
        For Each cwb In Workbooks

            **Call donemovementReport**
            ActiveWorkbook.Close True
            ActiveWorkbook.Close False
        Next cwb
    End Sub

在任务栏中逐个打开的所有文件上运行宏

2 个答案: