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

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

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

但是，如果在任何阶段都需要，我确实希望在多张图纸上覆盖单元格

因此，当我选择了多张图纸时，我希望弹出一个带有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

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

“确实要覆盖所选工作表中的单元格吗？”

是（继续所有选定页面）

否（选择当前页面并继续）

---

Cancel（取消操作并保留当前选择）。

这是一个非常棘手的问题，因为通过使用

工作簿\u 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

---

此解决方案验证事件工作表是否为激活工作表，以便触发多选过程

此外，如果用户选择仅更新激活的工作表，则该过程会使选择中包括的所有其他工作表与触发通风口的操作之前一样，而不是在所有这些单元格中输入

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

---

请注意，如果用户选择

No

此代码仍会更改所有其他工作表中的单元格…@EEM-是的，我现在意识到，如果单元格已经有值，则

vbNullString

可能不是所需的结果：（我几乎在那里：）这就是您想要的

No

仅更改

activesheet

，取消撤消是您没有预料到的副作用。你的用户有多优柔寡断？