使用VBA添加validation列表不稳定

SetWS工作表中,我在Worksheet_Deactivate中有以下代码:

Private Sub Worksheet_Deactivate() Dim ActWS, SetWS As Worksheet Set ActWS = ActiveWorkbook.Sheets("Activity_Plan") Set SetWS = ActiveWorkbook.Sheets("Settings") With ActWS.Range("J11:J20").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="=Settings!$AS$10:$AS$20" ' .IgnoreBlank = True .InCellDropdown = True End With ' End Sub 

RepWS工作表(我只创build几个图),我在Worksheet_Activate中有以下代码:

 Private Sub Worksheet_Activate() Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim ScopeWS, RepWS, ActWS, SetWS As Worksheet Set ScopeWS = ActiveWorkbook.Sheets("Scope") Set RepWS = ActiveWorkbook.Sheets("Rep") Set ActWS = ActiveWorkbook.Sheets("Activity_Plan") Set SetWS = ActiveWorkbook.Sheets("Settings") LRowScopeE = ScopeWS.Range("E" & Rows.Count).End(xlUp).Row If SetWS.Range("W17") > SetWS.Range("W18") Then ' MsgBox ("bla bla") Exit Sub End If RepWS.ChartObjects("Diagramm 3").Activate ActiveChart.SeriesCollection(1).Name = "=Scope!$M$4" ActiveChart.SeriesCollection(1).Values = "=Scope!$M$11:$M$" & LRowScopeE ActiveChart.SeriesCollection(1).XValues = "=Scope!$E$11:$E$" & LRowScopeE ActiveChart.SeriesCollection(2).Name = "=Scope!$P$4" ActiveChart.SeriesCollection(2).Values = "=Scope!$P$11:$P$" & LRowScopeE ActiveChart.SeriesCollection(3).Name = "=Scope!$U$4" ActiveChart.SeriesCollection(3).Values = "=Scope!$T$11:$T$" & LRowScopeE ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True ActiveChart.Axes(xlValue).TickLabels.NumberFormat = "#.##0 €" ActiveChart.FullSeriesCollection(1).DataLabels.NumberFormat = "#.##0 €" ActiveSheet.ChartObjects("Diagramm 14").Activate ActiveChart.SeriesCollection(1).Name = "=Settings!$CJ$10" ActiveChart.SeriesCollection(1).Values = "=Settings!$CJ$11:$CJ$" & SetWS.Range("CL8").Value ActiveChart.SeriesCollection(1).XValues = "=Settings!$CI$11:$CI$" & SetWS.Range("CL8").Value ActiveChart.SeriesCollection(2).Name = "=Settings!$CK$10" ActiveChart.SeriesCollection(2).Values = "=Settings!$CK$11:$CK$" & SetWS.Range("CL8").Value Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

当我从SetWS切换到RepWS时,它会引发错误

“应用程序定义或对象定义的错误”

并在SetWS中突出显示以下内容:

 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="=Settings!$AS$10:$AS$20" 

在这个文件中的任何其他一对表之间切换不会导致这个错误(例如,将SetWS切换到任何其他表是OK)。

更新:我注意到我更多的事情 – 只要我激活RepWS一次,任何进一步尝试从SetWS切换到RepWS会引发错误。 RepWS代码有问题

避免使用Active(Workbook/Sheet/Cell/Chart/...) .Activate/.Select方法和.Selection属性。

你的worksheet_activate子,可能看起来像这样

 Private Sub Worksheet_Activate() Dim ScopeWS, RepWS, ActWS, SetWS As Worksheet With Application .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual End With With ThisWorkbook Set ScopeWS = .Sheets("Scope") Set RepWS = .Sheets("Rep") Set ActWS = .Sheets("Activity_Plan") Set SetWS = .Sheets("Settings") End With LRowScopeE = ScopeWS.Range("E" & Rows.Count).End(xlUp).Row If SetWS.Range("W17") > SetWS.Range("W18") Then ' MsgBox ("bla bla") Else With RepWS 'Diagram 3 With .ChartObjects("Diagram 3").Chart 'Series 1 With .SeriesCollection(1) .Name = "=Scope!$M$4" .Values = "=Scope!$M$11:$M$" & LRowSco .XValues = "=Scope!$E$11:$E$" & LRowScopeE End With 'Series 2 With .SeriesCollection(2) .Name = "=Scope!$P$4" .Values = "=Scope!$P$11:$P$" & LRowScopeE End With 'Series 3 With .seriescolection(3) .Name = "=Scope!$U$4" .Values = "=Scope!$T$11:$T$" & LRowScopeE End With 'Layout With .Axes(xlValue) .MaximumScaleIsAuto = True .TickLabels.NumberFormat = "#.##0 €" End With .FullSeriesCollection(1).DataLabels.NumberFormat = "#.##0 €" End With 'Diagram 14 With .ChartObjects("Diagram 14").Chart 'Series 1 With .SeriesCollection(1) .Name = "=Settings!$CJ$10" .Values = "=Settings!$CJ$11:$CJ$" & SetWS.Range("CL8").Value .XValues = "=Settings!$CI$11:$CI$" & SetWS.Range("CL8").Value End With 'Series 2 With .SeriesCollection(2) .Name = "=Settings!$CK$10" .Values = "=Settings!$CK$11:$CK$" & SetWS.Range("CL8").Value End With End With End With End If With Application .EnableEvents = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub