vba - 更改文件名时自动更新宏

Question

我有以下宏来过滤包含员工时间文件的目录中的特定数据，并将其放入我的 zmaster 文件中。但是，我需要各种项目的各种主文档(例如，将名称更改为:“项目 300000”)。当我将主文件名从 zmaster 更改为其他任何名称时，我的宏显然找不到合适的文件。

有没有办法改变我的宏，使 zmaster.xlsm 在我的宏中自动替换为当前文件名？

Option Explicit

Sub CopyToMasterFile()

    Dim MasterWB As Workbook
    Dim MasterSht As Worksheet
    Dim MasterWBShtLstRw As Long
    Dim FolderPath As String
    Dim TempFile
    Dim CurrentWB As Workbook
    Dim CurrentWBSht As Worksheet
    Dim CurrentShtLstRw As Long
    Dim CurrentShtRowRef As Long
    Dim CopyRange As Range
    Dim ProjectNumber As String


    FolderPath = "C:\test\"
    TempFile = Dir(FolderPath)

    Dim WkBk As Workbook
    Dim WkBkIsOpen As Boolean

    'Check if zmaster is open already
    For Each WkBk In Workbooks
        If WkBk.Name = "zmaster.xlsm" Then WkBkIsOpen = True
    Next WkBk

    If WkBkIsOpen Then
        Set MasterWB = Workbooks("zmaster.xlsm")
        Set MasterSht = MasterWB.Sheets("Sheet1")
    Else
        Set MasterWB = Workbooks.Open(FolderPath & "zmaster.xlsm")
        Set MasterSht = MasterWB.Sheets("Sheet1")
    End If

    ProjectNumber = MasterSht.Cells(1, 1).Value



    Do While Len(TempFile) > 0

        'Checking that the file is not the master and that it is a xlsx
        If Not TempFile = "zmaster.xlsm" And InStr(1, TempFile, "xlsx", vbTextCompare) Then

            Set CopyRange = Nothing

            'Note this is the last used Row, next empty row will be this plus 1
            With MasterSht
                MasterWBShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
            End With

            Set CurrentWB = Workbooks.Open(FolderPath & TempFile)
            Set CurrentWBSht = CurrentWB.Sheets("Sheet1")

            With CurrentWBSht
                CurrentShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
            End With

            For CurrentShtRowRef = 1 To CurrentShtLstRw

             If CurrentWBSht.Cells(CurrentShtRowRef, "A").Value = ProjectNumber Then

               'This is set to copy from Column A to Column L as per the question

               If CopyRange Is Nothing Then
                 'If there is nothing in Copy range then union wont work
                 'so first row of the work sheet needs to set the initial copyrange
                  Set CopyRange = CurrentWBSht.Range("A" & CurrentShtRowRef & _
                                                ":L" & CurrentShtRowRef)
                Else
                  'Union is quicker to be able to copy from the sheet once
                  Set CopyRange = Union(CopyRange, _
                                        CurrentWBSht.Range("A" & CurrentShtRowRef & _
                                                            ":L" & CurrentShtRowRef))
               End If  ' ending   If CopyRange Is Nothing ....
             End If ' ending  If CurrentWBSht.Cells....

            Next CurrentShtRowRef

            CopyRange.Select

            'add 1 to the master file last row to be the next open row
            CopyRange.Copy MasterSht.Cells(MasterWBShtLstRw + 1, 1)

            CurrentWB.Close savechanges:=False

        End If     'ending            If Not TempFile = "zmaster.xlsx" And ....

        TempFile = Dir

    Loop

ActiveSheet.Range("A1:L200").RemoveDuplicates Columns:=Array(1, 2, 4, 8, 9, 10, 11, 12), Header:=xlYes

End Sub

Answer 1

摆脱硬编码工作簿名称的一种方法是使用 ActiveWorkbook或 ThisWorkbook对象 - 它们都返回 Workbook 的实例目的。

ThisWorkbook

Returns a Workbook object that represents the workbook where the current macro code is running. Read-only.

ActiveWorkbook

Returns a Workbook object that represents the workbook in the active window (the window on top). Read-only. Returns Nothing if there are no windows open or if either the Info window or the Clipboard window is the active window.

然后您可以使用 Name 获取工作簿的名称返回 Workbook 的属性目的。

另一种方法可能是将这样的数据作为参数传递给函数。
例如:

Sub CopyToMasterFile(wbName as String, sheetName as String)

在此变体中，如果您调用 Sub从另一个宏代码中，您可以传递您想要使用的任何内容 - 这样您就可以转义函数中的硬编码内容。
这也适用于 Worksheet对象 - 看看 ActiveSheet