在Excel中重命名工作表事件

时间：2009-12-21 12:49:48

标签： excel vba events

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

5 个答案:

答案 0 :(得分：4)

这是一种方法。诀窍是通过专用类将事件捕获到应用程序级别。使用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

使用工作簿打开事件使用全局变量实例化：

Public xlc As CExcelEvents

Sub Workbook_Open()
    Set xlc = New CExcelEvents
End Sub

上述示例仅在用户选择其他工作表时触发。如果您想要更多粒度，请同时监控Sheet Change事件。

答案 1 :(得分：3)

即使使用Application对象，显然也没有事件来处理它。多么烦人。

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

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

在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

答案 2 :(得分：1)

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

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

创建一个类模块，将其命名为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)
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

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

对于测试，您可以使用任何对象模块，例如ThisWorkbook模块，将以下代码放入其中：

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

保存工作簿，然后重新打开它，然后将分别提醒每个SheetRename和SheetDelete事件。

答案 3 :(得分：0)

我急切地等待着这个问题的答案，因为经过多次搜索后我还没有想出来。我找到的工作表上没有重命名事件，因此您不得不采用其他方法。

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

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

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

答案 4 :(得分：0)

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

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

  

= MID（CELL（“” filename“”，A1），FIND（“”]“”，CELL（“” filename“”，“ A1））+ 1,255）”

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

我不得不采用这种方法，因为我需要与客户端共享一些VBA代码，这使他可以通过编程方式以及在选项卡上键入来更改某些工作表名称。此方法捕获工作表名称更改事件，即使它是用代码完成的。

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

下面的代码在工作簿代码的后面：

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
相关问题
最新问题