Question

我的笔记本电脑上的两个shift键都卡住了很多，当我使用ctrl + page up / down导航时，我通常会在Excel中偶然编辑组表。

一位朋友给了我一个代码，我可以在VBA中粘贴ThisWorkbook但是，我有大量的excel文件。他给出的代码（下面）将取消我的组表编辑，并取消选择除其他表之外的所有代码。我想知道是否有一种方法可以在Personal.xlsb上运行，这样我就不必将此代码粘贴到我的所有文件上。

（我要感谢先进，我的互联网连接非常弱，所以我可能无法立即回复，但感谢您的帮助！）

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
If ActiveWindow.SelectedSheets.Count > 1 Then
Application.EnableEvents = False
Dim x As Integer
x = MsgBox("This will undo previous action taken. Do you want to continue?", vbYesNo, "Confirmation")
If x = vbYes Then
Application.Undo
Else
End If
ActiveSheet.Select
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
If ActiveWindow.SelectedSheets.Count > 1 Then
Application.EnableEvents = False
ActiveSheet.Select
Application.EnableEvents = True
End If
End Sub

Answer 1

在Personal.xlsb的新类模块clsAppEvents中：

Option Explicit

Private WithEvents App As Application

Private Sub Class_Initialize()
    Set App = Application
End Sub

Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Debug.Print "Changed sheet '" & Sh.Name & "' in workbook '" & Sh.Parent.Name & "'"
    If ActiveWindow.SelectedSheets.Count > 1 Then
        Application.EnableEvents = False
        Dim x As Integer
        If MsgBox("This will undo previous action taken. Do you want to continue?", _
                                  vbYesNo, "Confirmation") = vbYes Then
            Application.Undo
        End If
        ActiveSheet.Select
        Application.EnableEvents = True
    End If
End Sub

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Debug.Print "Selection on sheet '" & Sh.Name & "' in workbook '" & Sh.Parent.Name & "'"
    If ActiveWindow.SelectedSheets.Count > 1 Then
        Application.EnableEvents = False
        ActiveSheet.Select
        Application.EnableEvents = True
    End If
End Sub

在常规代码模块中：

Option Explicit

Dim oApp As clsAppEvents

Sub InitAppEvents()
    Set oApp = New clsAppEvents
End Sub

或者，您可以将其放在ThisWorkbook代码模块中，并将其链接到Workbook_Open事件。

运行InitAppEvents将开始捕获类模块中处理的事件。

注意：导致重置VBA项目的任何内容（例如编辑代码或未处理的错误）都意味着您需要重置捕获事件的类实例 - 即重新运行InitAppEvents

代码在ThisWorkbook中有效，但在Personal.xlsb中没有

1 个答案: