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

Question

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

然而，如果在任何阶段都需要，我确实希望可以在多个工作表中覆盖单元格。

因此，当我选择了多张图纸时，我希望弹出一个有2个选项的窗口，如下所示："是否确实要覆盖所选工作表中的单元格？"Ok取消

我想我已经完成了下面的代码，但如果我选择了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

Answer 2

这是非常棘手的，因为通过使用Workbook_SheetChange事件，代码将为您必须考虑的工作表更改的每个实例触发。

然而，通过巧妙地使用公共变量作为开关/计数器，并使用单独的子程序来处理哪些情况需要更改所有工作表与活动工作表与无工作表，我开发了经过彻底测试的代码。我还对我的代码进行了大量注释，以帮助理解其中的逻辑。

Option Explicit
Dim bAsked As Boolean
Dim dRet As Double
Dim iCnt As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Dim lSheets As Long
    lSheets = ActiveWindow.SelectedSheets.Count
    If lSheets > 1 Then Check lSheets, Sh, Target
    Application.EnableEvents = True
End Sub
Sub Check(iTotal As Long, ws As Worksheet, rng As Range)
'use this is a counter to count how many times the sub has been called in the firing of the 'Workbook_SheetChange` event
iCnt = iCnt + 1
'if the question has not been asked yet (first time event is fired)
If Not bAsked Then
    dRet = MsgBox("Are you sure you want to overwrite the cells across the sheets you have selected? Click Yes to overwrite all sheets, No to overwrite the Active Sheet, or Cancel to abort the entire overwrite.", vbYesNoCancel)
    bAsked = True 'set to true so question will only be asked once on event firing
End If

'dRet will always be the same for each instance an event is fired
Select Case dRet
    Case Is = vbYes
        'set the value for each range to what user entered
        ws.Range(rng.Address) = rng.Value2
    Case Is = vbNo
        'only set the value the user entered to the active worksheet (the one the user is on)
        If ActiveSheet.Name = ws.Name Then
            ws.Range(rng.Address) = rng.Value2
        Else
            ws.Range(rng.Address) = vbNullString
        End If
    Case Is = vbCancel
        'do not set any values on any sheet
        Application.Undo
End Select
'if the total times the sub has been called is equal to the total selected worksheet reset variables so they work next time
'if the count equals the total it's the last time the sub was called which means its the last sheet
If iCnt = iTotal Then
    bAsked = False
    iCnt = 0
End If
End Sub