vba - 选择多个页面时在 Excel 中创建警告，以防止意外覆盖单元格

Question

我正在尝试编写一些 Visual Basic 代码，以防止任何人在选择多个工作表时意外覆盖多个工作表中的单元格。

但是，如果在任何阶段需要的话，我确实希望能够选择覆盖多张工作表中的单元格。

因此，当我选择了多个工作表时，我希望弹出一个包含 2 个选项的窗口，如下所示:“您确定要覆盖所选工作表上的单元格吗？”确定取消

我想我已经接近使用下面的代码了，但是如果我选择了 3 张纸，那么弹出窗口将出现 3 次(每页一次)。当然，我只希望弹出窗口出现一次，无论我选择了多少张纸。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   If ActiveWindow.SelectedSheets.Count > 1 Then
   If MsgBox("Are you sure you want to overwrite the cells across the sheets you have selected?", vbOKCancel) = vbCancel Then Exit Sub
       Application.EnableEvents = False
       Application.Undo
    End If
   Application.EnableEvents = True
End Sub

或者更好的解决方案实际上是:

“您确定要覆盖所选工作表上的单元格吗？”

是(继续所有选定的页面)，

否(选择当前页面并继续)，

取消(取消操作并保留当前选择)。

Answer 1

此解决方案验证事件工作表是否是事件工作表，以便触发多重选择过程。

此外，如果用户选择仅更新事件工作表，则该过程会将所有其他工作表保留在选择中，就像触发通风口的操作之前一样，而不是在所有这些单元格中输入 vbNullString 值

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    If Sh.Name = ActiveSheet.Name Then Call Wsh_MultipleSelection(Target)
    Application.EnableEvents = True
End Sub

Private Sub Wsh_MultipleSelection(ByVal rTrg As Range)
Const kTtl As String = "Selection Across Multiple Sheets"
Const kMsg As String = "You are trying to overwrite cells across multiple sheets." & vbLf & _
    "Press [Yes] if you want to continue and overwrite the selected cells" & vbLf & _
    "Press [No] if you want to overwrite selected cells in active sheet only" & vbLf & _
    "Press [Cancel] to undo last action."
Const kBtt As Long = vbApplicationModal + vbQuestion + vbYesNoCancel + vbDefaultButton3

Dim iResp As Integer
Dim vCllVal As Variant
Dim bWshCnt As Byte

    bWshCnt = ActiveWindow.SelectedSheets.Count
    If bWshCnt > 1 Then
        bWshCnt = -1 + bWshCnt
        iResp = MsgBox(kMsg, kBtt, kTtl)
        Select Case iResp
        Case vbYes
            Rem NO ACTION!
        Case vbNo:
            Rem Select Only Active Sheet
            vCllVal = rTrg.Cells(1).Value2
            Application.Undo
            rTrg.Value = vCllVal
        Case Else
            Rem Cancel
            Application.Undo
    End Select: End If
End Sub