vba 在 Excel 中重命名工作表事件

Rename Worksheet Event in Excel

提问by macleojw

What is the best way to get some VBA code to run when a excel sheet is renamed?

重命名 Excel 工作表时，让某些 VBA 代码运行的最佳方法是什么？

采纳答案by macleojw

Here's one approach. The trick is to trap the events at an application level via a dedicated class. Using the SheetActivate event, store a reference to the active sheet as well as its name. When the sheet is deactiveated (and another activated) compare the name of the sheet reference against the stored string. Here's the class (called CExcelEvents):

这是一种方法。诀窍是通过专用类在应用程序级别捕获事件。使用 SheetActivate 事件，存储对活动工作表的引用及其名称。当工作表被停用（和另一个激活）时，将工作表引用的名称与存储的字符串进行比较。这是类（称为 CExcelEvents）：

Option Explicit

Private WithEvents xl As Application

Private CurrSheet As Worksheet
Private CurrSheetName As String


Private Sub Class_Initialize()
    Set xl = Excel.Application
    Set CurrSheet = ActiveSheet
    CurrSheetName = CurrSheet.Name
End Sub

Private Sub Class_Terminate()
    Set xl = Nothing
End Sub



Private Sub xl_SheetActivate(ByVal Sh As Object)
    If CurrSheetName <> CurrSheet.Name Then
        Debug.Print "You've renamed the sheet: " & CurrSheetName & " to " & CurrSheet.Name
'       Do something here - rename the sheet to original name?
    End If

    Set CurrSheet = Sh
    CurrSheetName = CurrSheet.Name
End Sub

Instantiate this with a global variable using the Workbook open event:

使用 Workbook open 事件用全局变量实例化它：

Public xlc As CExcelEvents

Sub Workbook_Open()
    Set xlc = New CExcelEvents
End Sub

The example above will trigger only when the user selects another worksheet. If you want more granularity, monitor the Sheet Change event as well.

仅当用户选择另一个工作表时，上面的示例才会触发。如果您需要更多粒度，还可以监视 Sheet Change 事件。

回答by Nossidge

There apparently is no Event to handle this, even using the Application object. How annoying.

即使使用 Application 对象，显然也没有 Event 来处理这个问题。多么烦人。

I'd probably try to capture it by storing the startup value of the Worksheet and checking it on as many events as possible - which is admittedly a hack.

我可能会尝试通过存储工作表的启动值并在尽可能多的事件上检查它来捕获它 - 这无疑是一个黑客。

The following seemed to work for me, Hope it helps.

以下似乎对我有用，希望它有所帮助。

In the ThisWorkbook module:

在 ThisWorkbook 模块中：

Private strWorksheetName As String

Private Sub Workbook_Open()
    strWorksheetName = shtMySheet.Name
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Call CheckWorksheetName
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Call CheckWorksheetName
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    Call CheckWorksheetName
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call CheckWorksheetName
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Call CheckWorksheetName
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call CheckWorksheetName
End Sub

Private Sub CheckWorksheetName()
    'If the worksheet has changed name'
    If shtMySheet.Name <> strWorksheetName Then

        DoSomething

    End If
End Sub

回答by Ambie

I know this is an old question but I've recently begun to use Excel's CELL("filename")function which returns details about both file and sheet names.

我知道这是一个老问题，但我最近开始使用 Excel 的CELL("filename")函数，该函数返回有关文件和工作表名称的详细信息。

We can parse the sheet name, using this well-known formula:

我们可以使用这个众所周知的公式解析工作表名称：

=MID(CELL(""filename"", A1),FIND(""]"",CELL(""filename""," A1))+1,255)"

=MID(CELL(""文件名"", A1),FIND(""]"",CELL(""文件名""," A1))+1,255)"

By writing this function to a hidden worksheet, and then monitoring the _Calculateevent on that sheet, we can catch any change to the worksheet name.

通过将此函数写入隐藏的工作表，然后监视该工作表上的_Calculate事件，我们可以捕获对工作表名称的任何更改。

I had to resort to this method because I needed to share some VBA code with a client, which gave him the possibility to change certain worksheet names programmatically as well as by typing onto the tab. This method captures a sheet name changed event even if it was made in code.

我不得不求助于这种方法，因为我需要与客户端共享一些 VBA 代码，这使他能够以编程方式以及通过在选项卡上键入来更改某些工作表名称。即使它是在代码中创建的，此方法也会捕获工作表名称更改事件。

In the skeleton code below, I've just captured the name change for the active worksheet but there's nothing to stop you adding a target worksheet list and adjusting the handling code accordingly.

在下面的骨架代码中，我刚刚捕获了活动工作表的名称更改，但没有什么可以阻止您添加目标工作表列表并相应地调整处理代码。

The code below is in the Workbook code-behind:

下面的代码在工作簿代码隐藏中：

Option Explicit
Private mSheetNamesWS As Worksheet
Private mOldSheetName As String

Private Sub Workbook_Open()

    'Find or create the hidden worksheet
    'containing the sheet reference.
    On Error Resume Next
    Set mSheetNamesWS = Me.Worksheets("SheetNames")
    On Error GoTo 0

    If mSheetNamesWS Is Nothing Then

        'Disable events so that the _calculate event
        'isn't thrown.
        Application.EnableEvents = False

        Set mSheetNamesWS = Me.Worksheets.Add
        With mSheetNamesWS
            .Name = "SheetNames"
            .Visible = xlSheetVeryHidden
        End With

        Application.EnableEvents = True

    End If

    'Update the sheet reference.
    If TypeOf ActiveSheet Is Worksheet Then
        UpdateCellFormula
    End If

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    'Active sheet has changed so update the reference.
    If TypeOf ActiveSheet Is Worksheet Then
        UpdateCellFormula
    End If
End Sub

Private Sub UpdateCellFormula()
    Dim cellRef As String

    'Sense check.
    If mSheetNamesWS Is Nothing Then Exit Sub

    'The CELL function returns details about
    'the file and sheet name of any
    'specified range.
    'By adding a formula that extracts the
    'sheet name portion from the CELL function,
    'we can listen for any changes
    'of that value in the _calculate event method.

    'Disable events to avoid a spurious
    '_calculate event.
    Application.EnableEvents = False
    cellRef = ActiveSheet.Name & "!A1"
    With mSheetNamesWS.Range("A1")
        .Formula = _
            "=MID(CELL(""filename""," & _
            cellRef & _
            "),FIND(""]"",CELL(""filename""," & _
            cellRef & _
            "))+1,255)"
        mOldSheetName = .Value
    End With
    Application.EnableEvents = True

End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

    'Disregard any sheet that isn't our reference sheet.
    If Not Sh Is mSheetNamesWS Then Exit Sub

    'The reference sheet has recalculated.
    'It means the value of the cell containing
    'the current sheet name has changed.
    'Ergo we have a sheet name change.

    'Handle the event here ...
    MsgBox "You can't change the name of this sheet!"
    Application.EnableEvents = False
    ActiveSheet.Name = mOldSheetName
    Application.EnableEvents = True

End Sub

回答by omegastripes

The only event firing after sheet renamed is Application.CommandBars_OnUpdate. Based on this you may create the code which makes fast check if any sheet name changed. Apparently such approach looks clunky and has some overhead due to OnUpdateevent fires almost on any application's change, anyway that is better than nothing. I noticed that after Application_SheetSelectionChangeit fires at most about two times per second although, so it should not hang the application.

工作表重命名后唯一触发的事件是Application.CommandBars_OnUpdate. 基于此，您可以创建代码来快速检查是否有任何工作表名称更改。显然，这种方法看起来很笨拙，并且由于OnUpdate几乎在任何应用程序更改时都会触发事件，因此有一些开销，无论如何总比没有好。我注意到，在Application_SheetSelectionChange它最多每秒触发两次之后，所以它不应该挂起应用程序。

Here is wrapper class example showing how Application.CommandBars_OnUpdateevent can help to track some extra worksheet events like add, rename, move and delete.

这是包装类示例，展示了Application.CommandBars_OnUpdate事件如何帮助跟踪一些额外的工作表事件，如添加、重命名、移动和删除。

Create a Class Module, name it cSheetEventsand place there the below code:

创建一个类模块，命名cSheetEvents并放置以下代码：

Option Explicit

Public Event SheetAdd(ByVal wb As Workbook, ByVal sh As Object)
Public Event SheetRename(ByVal wb As Workbook, ByVal sh As Object, ByVal oldName As String)
Public Event SheetMove(ByVal wb As Workbook, ByVal sh As Object, ByVal oldIndex As Long)
Public Event SheetDelete(ByVal wb As Workbook, ByVal oldName As String, ByVal oldIndex As Long)

Private WithEvents app As Application
Private WithEvents appCmdBars As CommandBars
Private skipCheck As Boolean
Private sheetData As Object

Private Sub Class_Initialize()

    Set app = Application
    Set appCmdBars = Application.CommandBars
    Set sheetData = CreateObject("Scripting.Dictionary")
    Dim wb As Workbook
    For Each wb In app.Workbooks
        Dim sh As Object
        For Each sh In wb.Sheets
            sheetData(sh) = Array(sh.Name, sh.Index, wb)
        Next
    Next

End Sub

Private Sub Class_Terminate()

    Set sheetData = Nothing

End Sub

Private Sub app_NewWorkbook(ByVal wb As Workbook)

    Dim sh As Object
    For Each sh In wb.Sheets
        sheetData(sh) = Array(sh.Name, sh.Index, wb)
    Next

End Sub

Private Sub app_WorkbookOpen(ByVal wb As Workbook)

    Dim sh As Object
    For Each sh In wb.Sheets
        sheetData(sh) = Array(sh.Name, sh.Index, wb)
    Next

End Sub

Private Sub app_WorkbookNewSheet(ByVal wb As Workbook, ByVal sh As Object)

    sheetData(sh) = Array(sh.Name, sh.Index, wb)
    skipCheck = True

End Sub

Private Sub app_SheetChange(ByVal sh As Object, ByVal Target As Range)

    skipCheck = True

End Sub

Private Sub appCmdBars_OnUpdate()

    If skipCheck Then
        skipCheck = False
    Else
        Dim wb As Workbook
        For Each wb In app.Workbooks
            Dim sh As Object
            For Each sh In wb.Sheets
                If Not sheetData.exists(sh) Then
                    sheetData(sh) = Array(sh.Name, sh.Index, wb)
                    RaiseEvent SheetAdd(wb, sh)
                End If
            Next
        Next
        On Error Resume Next
        For Each sh In sheetData
            Set wb = sheetData(sh)(2)
            If wb.Name = "" Then
                sheetData.Remove sh
                Set sh = Nothing
                Set wb = Nothing
            Else
                Dim oldName As String
                oldName = sheetData(sh)(0)
                Dim oldIndex As Long
                oldIndex = sheetData(sh)(1)
                If sh.Name = "" Then
                    sheetData.Remove sh
                    Set sh = Nothing
                    RaiseEvent SheetDelete(wb, oldName, oldIndex)
                Else
                    If sh.Name <> oldName Then
                        sheetData(sh) = Array(sh.Name, sh.Index, wb)
                        RaiseEvent SheetRename(wb, sh, oldName)
                    ElseIf sh.Index <> oldIndex Then
                        sheetData(sh) = Array(sh.Name, sh.Index, wb)
                        RaiseEvent SheetMove(wb, sh, oldIndex)
                    End If
                End If
            End If
        Next
    End If

End Sub

In the example some unnecessary OnUpdateevents right after Application_SheetChangeskipped to reduce overhead by adding flag variable. You may try to skip other unnecessary events. Note, that e. g. Application_SheetSelectionChangeevent fires when a user renames the sheet by typing and after that clicks on whatever (not selected) cell on the sheet, and Application_SheetCalculateevent fires when the sheet is renamed and there are volatile formulas exist somewhere.

在示例中，一些不必要的OnUpdate事件在Application_SheetChange跳过后立即通过添加标志变量来减少开销。您可以尝试跳过其他不必要的事件。请注意，例如，Application_SheetSelectionChange当用户通过键入重命名工作表时会触发事件，然后单击工作表上的任何（未选择）单元格，并且Application_SheetCalculate当工作表重命名并且某处存在易失性公式时会触发事件。

For testing you may use any object module, let's say, ThisWorkbookModule, place the below code in it:

为了进行测试，您可以使用任何对象模块，比如说，ThisWorkbookModule，将以下代码放入其中：

Option Explicit

Private WithEvents sheetEvents As cSheetEvents

Private Sub Workbook_Open()

    Set sheetEvents = New cSheetEvents

End Sub

Private Sub sheetEvents_SheetAdd(ByVal wb As Workbook, ByVal sh As Object)

    MsgBox _
        "Sheet added" & vbCrLf & _
        Now & vbCrLf & vbCrLf & _
        "Workbook: " & wb.Name & vbCrLf & _
        "Name: " & sh.Name

End Sub

Private Sub sheetEvents_SheetRename(ByVal wb As Workbook, ByVal sh As Object, ByVal oldName As String)

    MsgBox _
        "Sheet renamed" & vbCrLf & _
        Now & vbCrLf & vbCrLf & _
        "Workbook: " & wb.Name & vbCrLf & _
        "Old name: " & oldName & vbCrLf & _
        "New name: " & sh.Name

End Sub

Private Sub sheetEvents_SheetMove(ByVal wb As Workbook, ByVal sh As Object, ByVal oldIndex As Long)

    MsgBox _
        "Sheet renamed" & vbCrLf & _
        Now & vbCrLf & vbCrLf & _
        "Workbook: " & wb.Name & vbCrLf & _
        "Name: " & sh.Name & vbCrLf & _
        "Old index: " & oldIndex & vbCrLf & _
        "New index: " & sh.Index

End Sub

Private Sub sheetEvents_SheetDelete(ByVal wb As Workbook, ByVal oldName As String, ByVal oldIndex As Long)

    MsgBox _
        "Sheet deleted" & vbCrLf & _
        Now & vbCrLf & vbCrLf & _
        "Workbook: " & wb.Name & vbCrLf & _
        "Name: " & oldName & vbCrLf & _
        "Index: " & oldIndex

End Sub

Save the workbook, and reopen it, after that each SheetRenameand SheetDeleteevent will be alerted.

保存工作簿，并重新打开它，之后每个SheetRename和SheetDelete事件将被警告。

回答by Simon

I'm eagerly awaiting an answer to this because I haven't figured it out after much searching. There is no rename event on a worksheet that I have found, so you are forced to have an alternative approach.

我急切地等待这个答案，因为经过多次搜索我还没有弄清楚。我发现工作表上没有重命名事件，因此您不得不采用替代方法。

The best one I have seen (which is awful) is to prohibit rename on the sheets by making them read-only or invisible, and then provide your own toolbar or button that does the rename. Very ugly and users hate it.

我见过的最好的方法（很糟糕）是通过将工作表设置为只读或不可见来禁止在工作表上重命名，然后提供您自己的工具栏或按钮来进行重命名。非常丑陋，用户讨厌它。

I have also seen applications that disable the rename menu item in the office toolbar, but that doesn't prevent double-clicking the tab and renaming there. Also very ugly and users hate it.

我还看到过禁用 office 工具栏中重命名菜单项的应用程序，但这并不能阻止双击选项卡并在那里重命名。也非常丑陋，用户讨厌它。

Good luck, I hope someone comes up with a better answer.

祝你好运，我希望有人提出更好的答案。