Question

在 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 表格中（我只创建了几张图表）我在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时，它会抛出错误

＆＃34;应用程序定义或对象定义错误＆＃34;

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

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

在此文件中的任何其他纸张对之间切换不会导致此错误（例如，将SetWS切换到任何其他工作表都可以。）

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

Answer 1

避免使用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

使用VBA添加验证列表不稳定

1 个答案: