一旦触发按钮上的宏，工作表中的事件代码将停止工作

Question

我有一个工作簿，当事件发生时，工作表中的代码会被触发。我在该工作表中还有一个按钮，用于将数据从此工作簿"导出"到新工作簿。该部分有效，但当我想在原始文件中工作时，它不再触发工作簿中的任何事件，除非我关闭Excel并重新打开它。

在按下按钮并创建新文件后，我如何在另一个文件中工作，并且仍然让事件工作

一个有用的注意事项可能是：
将数据导出到新工作簿时，我不会删除工作簿中现有的宏。我找了一条没有成功的路。

工作表代码

Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("1:9")) Is Nothing Then
'This ensures that these rows gets skipped in the code
Else
If Target.Count > 1 Then 'Check who last modified it
Else
Cells(Target.Row, "H").Value = Application.UserName
End If

If Not Intersect(Target, Range("UGCImagePath1, UGCImagePath2, UGCImagePath3")) Is Nothing Then
'Checks if field is edited in UGCImagePath1 and then adds formulas in the next two fields
Sheets("Data Validation Sheet").Range("PreviewFormula").Copy
Sheets("PDP_CMS_Product_Data").Cells(Target.Row, Target.Column + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Sheets("Data Validation Sheet").Range("ResetPreviewFormula").Copy
Sheets("PDP_CMS_Product_Data").Cells(Target.Row, Target.Column + 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End If

On Error Resume Next
If Not Intersect(Target, Range("GoToCell")) Is Nothing Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
ActiveSheet.Range("GoToCell").Value, TextToDisplay:=Range("D2").Value
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveSheet.Range("GoToCell").Font.FontStyle = "Bold"
ActiveSheet.Range("GoToCell").Font.Underline = xlUnderlineStyleNone
ActiveSheet.Range("GoToCell").Font.Color = vbBlack
End If
Application.EnableEvents = True
End Sub

"导出按钮"的代码

Sub ExportPDButton()
'Start Export
Sheets("PDP_CMS_Index_Transpose").Visible = True
Sheets("PDP_CMS_CompSet_Transpose").Visible = True
Sheets(Array("PDP_CMS_CompSet_Transpose", "PDP_CMS_Product_Data", "PDP_CMS_Copy", _
"PDP_CMS_Index", "PDP_CMS_Index_Transpose")).Copy

'Structure PDP_CMS_CompSet_Transpose
Sheets("PDP_CMS_CompSet_Transpose").Select
Rows("1:2").Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PDP_CMS_CompSet_Transpose").Name = "PDP_CMS_Component_Settings"

'Structure PDP_CMS_Product_data
Sheets("PDP_CMS_Product_Data").Select

Sheets("PDP_CMS_Product_Data").Shapes.Range(Array("CBShowMenuPD", "CBCallOutPD", _
"CBBenefitChildrenPD", "CBBenefitParentsPD", "CBVideoPD", "CBWITBPD", _
"CBSpecificationsPD", "CBTechHighlightPD", "CBMarqueePD", "CBFAQPD", "CBUGCPD" _
, "CBBrandPD", "ShowComponentSettingsSheet", "ExportPDButton")).Delete
Rows("1:8").Delete
Rows("1:50010").Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A1:DL50009").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$DL$50009").AutoFilter Field:=7, Criteria1:= _
"<>TRUE", Operator:=xlAnd
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
'Structure PDP_CMS_Copy
Sheets("PDP_CMS_Copy").Select
Sheets("PDP_CMS_Copy").Shapes.Range(Array("CBShowMenuPD", "CBCallOutPD", _
"CBBenefitChildrenPD", "CBBenefitParentsPD", "CBTechHighlightPD", "CBMarqueePD", "CBFAQPD", "CBUGCPD")).Delete
Rows("1:8").Delete
Rows("1:50010").Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Structure PDP_CMS_Index_Transpose
Sheets("PDP_CMS_Index_Transpose").Select
Rows("1:1000").Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Sheets("PDP_CMS_Index").Delete
Application.DisplayAlerts = True
Sheets("PDP_CMS_Index_Transpose").Name = "PDP_CMS_Index"

'Closing the sheets in the original workbook for user interface purposes
Workbooks("NewPDP V.05").Sheets("PDP_CMS_Index_Transpose").Visible = False
Workbooks("NewPDP V.05").Sheets("PDP_CMS_CompSet_Transpose").Visible = False
'Save Export of PDP
Workbooks(Workbooks.Count).Sheets("PDP_CMS_Product_Data").Select
Dim DateOfToday As String
Dim TimeOfExport As String
ExportPDP = "ExportPageDesignerPDP"
DateOfToday = Format(Date, "yymmdd")
TimeOfExport = Format(Time, "hhmmss")
ActiveWorkbook.Application.Dialogs(xlDialogSaveAs).Show ExportPDP & DateOfToday & TimeOfExport
End Sub

我想在不关闭Excel的情况下继续工作。

Answer 1

VBA是单线程的。不能同时运行代码和事件代码。修改应用程序级别标志时必须非常小心。你需要适当的错误陷阱来确保一切都以理智的状态结束。

我会从您的活动中删除操作代码。将Worksheet_Change事件中的所有内容拉入一个名为OnWorksheetChange的新子中。

然后在导出部分，我们需要遵循类似的模式。在导出代码结束时设置Application.EnableEvents = True将确保它始终返回到侦听事件。(这回答了你的主要问题(

所以事件看起来是这样的：

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errHandler
Application.EnableEvents = False

OnWorksheetChange Target
errHandler:
Application.EnableEvents = True
End Sub
Private Sub OnWorksheetChange(ByVal Target As Range)
' Your code goes here
End Sub

Public Sub ExportPDButton()
On Error GoTo errHandler
Application.EnableEvents = False

' Your code goes here

errHandler:
Application.EnableEvents = True
End Sub

注意：任何时候您必须使用On Error Resume Next，该代码块都需要驻留在它自己的子例程中，以避免spagetti。如果你遵循这个规则，那么你的主要子系统和错误陷阱将始终有效。错误跳过仅限于过程级别，因此不必在一个子例程中多次设置On Error。

考虑将目标与各自过程进行比较的每个事件部分拆分。然后，您的事件中可能包含逻辑，并且操作是分开的。