Rename Worksheet Event in Excel
What is the best way to g开发者_JS百科et some VBA code to run when a excel sheet is renamed?
There apparently is no Event to handle this, even using the Application object. How annoying.
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:
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
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):
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:
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.
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.
We can parse the sheet name, using this well-known formula:
=MID(CELL(""filename"", A1),FIND(""]"",CELL(""filename""," A1))+1,255)"
By writing this function to a hidden worksheet, and then monitoring the _Calculate
event on that sheet, we can catch any change to the worksheet name.
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.
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
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.
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.
Good luck, I hope someone comes up with a better answer.
精彩评论