Prevent renaming worksheets without locking the workbook structure

[Jaafar Tribak]

Hi,

I have seen this question asked before and the usual workaround is to restore the worksheet name after the sheet has been renamed.. This is often done in the Worksheet Selection Change or deactivate events as follows :

Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
    If ActiveSheet.Name <> "SheetOldName" Then
        ActiveSheet.Name = "SheetOldName"
    End If
End Sub

For a more defensive programming style and for a bit of fun, here is a pseudo-event alternative that actually fires the code before the user attempts to rename the worksheet...


Code in the ThisWorkbook Module:

Option Explicit

Private WithEvents CmndBrs As CommandBars

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private hwnd As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private hwnd As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Sub Workbook_Open()
    Set CmndBrs = Application.CommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If CmndBrs Is Nothing Then Set CmndBrs = Application.CommandBars
End Sub

Private Sub CmndBrs_OnUpdate()
    Dim bCancel As Boolean
    
    hwnd = FindWindowEx(FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString), 0, "EXCEL=", vbNullString)
    
    If hwnd Then
        Call Workbook_SheetBeforeRename(ActiveSheet, bCancel)
        If bCancel Then DestroyWindow hwnd
    End If
End Sub

[B][COLOR=#008000]'======================================================================
'SheetBeforeRename Pseudo-event - Example : Prevents renaming Sheet1
'======================================================================[/COLOR][/B]
Private Sub Workbook_SheetBeforeRename(ByVal Sh As Object, ByRef Cancel As Boolean)
    If Sh Is Sheet1 Then
        [COLOR=#0000ff][B]Cancel = True[/B][/COLOR]
        MsgBox "You can't rename sheet:  '" & Sh.Name & "'", vbCritical
    End If
End Sub