Rename Worksheet Event in Excel

后端 未结 5 413
既然无缘
既然无缘 2020-12-09 12:15

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

5条回答
  •  Happy的楠姐
    2020-12-09 12:38

    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 OnUpdate event fires almost on any application's change, anyway that is better than nothing. I noticed that after Application_SheetSelectionChange it fires at most about two times per second although, so it should not hang the application.

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

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

    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)
    Public Event SheetAny()
    
    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)
        RaiseEvent SheetAdd(wb, sh)
        RaiseEvent SheetAny
        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 anyEvt As Boolean
            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)
                        anyEvt = True
                    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)
                        anyEvt = True
                    Else
                        If sh.Name <> oldName Then
                            sheetData(sh) = Array(sh.Name, sh.index, wb)
                            RaiseEvent SheetRename(wb, sh, oldName)
                            anyEvt = True
                        ElseIf sh.index <> oldIndex Then
                            sheetData(sh) = Array(sh.Name, sh.index, wb)
                            RaiseEvent SheetMove(wb, sh, oldIndex)
                            anyEvt = True
                        End If
                    End If
                End If
            Next
            If anyEvt Then
                RaiseEvent SheetAny
            End If
        End If
        
    End Sub
    
    
    

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

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

    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 SheetRename and SheetDelete event will be alerted.

提交回复
热议问题