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

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

不过，我想要覆盖多个单元格的单元格的选项，应该在任何阶段都需要。

所以，当我select了多个工作表时，我想popup两个选项，如下所示：“您确定要覆盖您select的工作表上的单元吗？ 确定取消

我觉得我几乎在下面的代码，但如果我有3张select，然后popup将出现3次（每页一次）。 当然，我只想让popup窗口出现一次，而不pipe我select了多less张。

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 

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

“你确定要覆盖你选中的单元格吗？”

是（继续所有选定的页面），

否（select当前页面并继续），

取消（取消操作并保持当前select）。

Answer 1

此解决schemevalidation事件工作表是否为活动工作表以激发“多选”过程。

另外，如果用户select仅更新活动工作表，则该过程保留select中包括的所有其他工作表，如同在触发通风口的操作之前一样，而不是在所有那些单元格中inputvbNullString值

 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事件，代码将针对您必须考虑的每个表单更改实例触发。

然而，通过使用一些公共variables作为开关/计数器和一个单独的子程序，以处理哪些情况改变所有与主动与没有工作表，我已经开发了已经过彻底testing的代码。 我也大量评论我的代码，以帮助理解逻辑。

 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