如何捕获通过 Excel VBA 中的复制/粘贴添加的工作表

How to capture worksheet being added through Copy/Paste in Excel VBA

提问by Adarsha

I am trying to capture worksheets being copied in to a workbook from another workbook.
Workbook_NewSheetevent does not trigger when the sheets are copied from another workbook. It is triggered only if the user manually inserts them through (Insert->Worksheet menu option), or when you add a new sheet through VBA as ThisWorkbook.Worksheets.Add.

我正在尝试捕获从另一个工作簿复制到工作簿中的工作表。
Workbook_NewSheet从另一个工作簿复制工作表时不会触发事件。仅当用户通过（插入-> 工作表菜单选项）手动插入它们时，或者当您通过 VBA 添加新工作表作为ThisWorkbook.Worksheets.Add.

What I am trying to capture is basically a Paste operation which is resulting in a new sheet.

我试图捕获的基本上是一个粘贴操作，它会产生一个新的工作表。

This might be from any of the below user actions:

这可能来自以下任何用户操作：

1. User copies an existing sheet by dragging it holding Control Key (which adds a new sheet)
2. User copies sheet/s from another workbook
3. user moved sheets from another workbook

1. 用户通过按住 Control 键拖动现有工作表来复制现有工作表（添加新工作表）
2. 用户从另一个工作簿复制工作表
3. 用户从另一个工作簿移动工作表

or any of the below VBA code:

或以下任何 VBA 代码：

SourceWorkbook.Sheets(“SourceSheet”).Copy Before:=TargetWorkbook.worksheets(“SheetNameIn Target”) 'copy across workbook'  
SourceWorkbook.Sheets(“SourceSheet”).Move Before:=TargetWorkbook.worksheets(“SheetNameIn Target”) 'move across workbook'  
ThisWorkbook. Sheets(“SheetName”).Copy 'copy within workbook'  

If you know any way of capturing this action/macro results within VBA that would be greatly helpful.

如果您知道在 VBA 中捕获此操作/宏结果的任何方法，那将非常有帮助。

Please note that I do not want to avoid such an user action (so i do not want to secure the workbook) but I want to handle the pasted sheet programatically to verify the data, and if the similar sheet already exists then update the existing sheet rather than having same data in two sheets.

请注意，我不想避免这样的用户操作（所以我不想保护工作簿），但我想以编程方式处理粘贴的工作表以验证数据，如果类似的工作表已经存在，则更新现有工作表而不是在两张纸上有相同的数据。

采纳答案by Adarsha

The way I have it implimented is

我有它implimented的方式是

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
ToggleMenuOptions False, 848, 889
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
ToggleMenuOptions True, 847, 848, 889
End Sub

Public Function ToggleMenuOptions(bToggle As Boolean, ParamArray ControlID() As Variant) As Boolean
'848 Move or Copy Sheet...
'889 Rename Sheet
'847 Delete Sheet
On Error GoTo lblError
Dim oControl As CommandBarControl, oControls As CommandBarControls, iControl As Integer
If IsMissing(ControlID) Then
    ToggleMenuOptions = False
    Exit Function
End If

For iControl = LBound(ControlID) To UBound(ControlID)
    For Each oControl In Application.CommandBars.FindControls(ID:=ControlID(iControl))
        oControl.Enabled = bToggle
    Next
Next
ToggleMenuOptions = True
Exit Function
lblError:
    If Err.Number Then
        ToggleMenuOptions = False
        Exit Function
    End If
End Function

Private Sub Workbook_NewSheet(ByVal Sh As Object)
MsgBox "Please use Add New Project option in custom Toolbar to add new sheets!!", vbExclamation, "Not Supported"
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub

So my users wont be able to rename, add or delete sheets. This is working pretty well for now.

所以我的用户将无法重命名、添加或删除工作表。这目前工作得很好。

回答by Dick Kusleika

The SheetActivate event will fire under all of those circumstances. Obviously it will fire under a lot of other circumstances too. This sounds like a royal pain, but you could maintain your own collection of worksheets and compare your collection to the ThisWorkbook.Sheets collection to see if something was added/deleted.

SheetActivate 事件将在所有这些情况下触发。显然，它也会在许多其他情况下触发。这听起来很痛苦，但您可以维护自己的工作表集合，并将您的集合与 ThisWorkbook.Sheets 集合进行比较，以查看是否添加/删除了某些内容。

If you're trying to prevent it, you might consider protecting the workbook structure instead of doing it in code.

如果您试图阻止它，您可以考虑保护工作簿结构而不是在代码中进行。

回答by Carl

When a sheet is copied, its name will always end with "(2)", or at least ")". You could check on that like this

复制工作表时，其名称将始终以“(2)”或至少以“)”结尾。你可以像这样检查

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name Like "*(2)" Then
        Application.DisplayAlerts = False
        Sh.Delete
        Application.DisplayAlerts = True
    End If
End Sub

回答by blackworx

The only way I can think of doing this without maintaining a separate sheets collection is to maintain a static array of sheet names (or sheet codenames) and compare this to the actual sheets in the workbook each time the SheetActivate event fires to detect any additions. If you don't want to/can't keep the list in an array you could always use a hidden sheet to store the list. Whether this is any more or less of a pain than maintaining a separate collection is debatable :)

在不维护单独的工作表集合的情况下，我能想到的唯一方法是维护工作表名称（或工作表代号）的静态数组，并在每次触发 SheetActivate 事件以检测任何添加时将其与工作簿中的实际工作表进行比较。如果您不想/不能将列表保留在数组中，您可以始终使用隐藏表来存储列表。这是否比维护一个单独的集合更痛苦还是更少的痛苦是有争议的:)

回答by Conor

I am working on something similar but cannot block any of the user menu actions. I have sheets whose type are important - each sheet is either a Master or Slave - each Master sheet sums over the Slave sheets beneath it and I need to keep these formula clean.

我正在做类似的事情，但无法阻止任何用户菜单操作。我有类型很重要的工作表 - 每张工作表要么是主表要么是从表 - 每个主表总和在它下面的从表上，我需要保持这些公式干净。

Rather than maintain a list of sheets in an extra hidden sheet, I am defining 2 hidden names on each sheet recording the offset of the index of the Sheet to its linked Master sheet, and a reference to the linked Master sheet. So if my sheet is (say) +2 tabs from its Master sheet, then on Sheet activate/deactivate (not sure which of these is better to track at this stage) this offset will have changed if anything gets inserted, deleted or moved. This covers most or all of the events that would arise from moving or copying sheets.

我没有在额外的隐藏工作表中维护工作表列表，而是在每张工作表上定义 2 个隐藏名称，记录工作表的索引与其链接的主工作表的偏移量，以及对链接的主工作表的引用。因此，如果我的工作表是（比方说）来自其主工作表的 +2 个标签，那么在工作表上激活/停用（不确定在此阶段跟踪哪个更好），如果插入、删除或移动任何内容，此偏移量将发生变化。这涵盖了由于移动或复制工作表而引起的大部分或全部事件。

If the sheet has been moved, I cycle through the workbook and calculate new Master/Slave index references for every sheet.

如果工作表已移动，我会循环浏览工作簿并为每张工作表计算新的主/从索引引用。

Will post code when I get this reasonably stable but it seems like a scheme that would work in a wide variety of circumstances.

当我得到这个相当稳定的时候会发布代码，但它似乎是一个可以在各种情况下工作的方案。