选择多个页面时,在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