Question

在我的工作簿的每一页上，我都有一个由状态框组成的状态栏。有三种状态 - “Tab Started”，“Design Updated”和“Configurations Complete”。最初我在每个页面都调用了这些框（并使用绝对引用），但我最近尝试通过将代码移动到单独的模块并在顶部附近的每个工作簿页面上调用它来提高工作簿的效率和灵活性（+使用“查找”而不是绝对引用来设置变量。

然而，虽然这在90％的时间或更长时间内有效，但有时我会收到错误消息“Out of Stack Space”。在MSDN上读取，没有任何可能触发此错误的示例似乎适用于我的代码（例如，代码不会调用自身）。

请参阅下面的代码。

'This function is called by all workbook tabs and controls the status boxes

Sub StatusBars(ByVal Target As Range)

Dim TabStarted1 As Range
Set TabStarted1 = ActiveSheet.Range("A4:Z5").Find("Tab Started")
Dim TabStarted As Range
Set TabStarted = TabStarted1.Offset(0, 1) 

Dim Design1 As Range
Set Design1 = ActiveSheet.Range("A6:Z7").Find("Design Updated")
Dim Design As Range
Set Design = Design1.Offset(0, 1)

Dim Configurations1 As Range
Set Configurations1 = ActiveSheet.Range("A8:Z9").Find("Configurations Complete")
Dim Configurations As Range
Set Configurations = Configurations1.Offset(0, 1)

If Not Intersect(Target, TabStarted) Is Nothing Then
    If Target.Cells.Count = 2 Then
        If WorksheetFunction.CountA(Target) = 0 Then 'If box is empty, then add an X, format it, change the box color and the tab color

            TabStarted.Value = "X"
            TabStarted.HorizontalAlignment = xlCenter
            TabStarted.Font.Size = 25
            TabStarted.Interior.Color = RGB(255, 255, 0)
            Design.Interior.Color = RGB(255, 255, 255)
            Design.Value = ""
            Configurations.Interior.Color = RGB(255, 255, 255)
            Configurations.Value = ""
            ActiveSheet.Tab.Color = RGB(255, 255, 0)

        Else 'if box is already checked clear, the X, the color, and the tab color
            TabStarted.Interior.Color = RGB(255, 255, 255)
            TabStarted.Value = ""
            ActiveSheet.Tab.ColorIndex = xlColorIndexNone
       End If
    End If

End If

If Not Intersect(Target, Design) Is Nothing Then
    If Target.Cells.Count = 2 Then
        If WorksheetFunction.CountA(Target) = 0 Then
            Design.Value = "X"
            Design.HorizontalAlignment = xlCenter
            Design.Font.Size = 25
            Design.Interior.Color = RGB(0, 112, 192)
            TabStarted.Interior.Color = RGB(255, 255, 255)
            TabStarted.Value = ""
            Configurations.Interior.Color = RGB(255, 255, 255)
            Configurations.Value = ""
            ActiveSheet.Tab.Color = RGB(0, 112, 192)

        Else
            Design.Interior.Color = RGB(255, 255, 255)
            Design.Value = ""
            ActiveSheet.Tab.ColorIndex = xlColorIndexNone
        End If
    End If

End If

If Not Intersect(Target, Configurations) Is Nothing Then
    If Target.Cells.Count = 2 Then
        If WorksheetFunction.CountA(Target) = 0 Then
            Configurations.Value = "X"
            Configurations.HorizontalAlignment = xlCenter
            Configurations.Font.Size = 25
            Configurations.Interior.Color = RGB(0, 176, 80)
            TabStarted.Interior.Color = RGB(255, 255, 255)
            TabStarted.Value = ""
            Design.Interior.Color = RGB(255, 255, 255)
            Design.Value = ""
            ActiveSheet.Tab.Color = RGB(0, 176, 80)

        Else
            Configurations.Interior.Color = RGB(255, 255, 255)
            Configurations.Value = ""
            ActiveSheet.Tab.ColorIndex = xlColorIndexNone
        End If
    End If

End If

End Sub

编辑：调用此函数的代码示例：

'Remove Case Sensitivity
  Option Compare Text

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False


Dim var1 As Variant
Dim var2 As Variant
Dim var3 As Variant

Dim PlusTemplates As Range
Set PlusTemplates = Range("A14:Z15").Find("+")

Call StatusBars(Target)

[rest of the code]
Application.ScreenUpdating = True
End Sub

Answer 1

Activesheet是一个全局变量。当您使用Activesheet设置tabstarted1等时，因为activesheet在堆栈上并且没有处理，所以其他变量如tabstarted1，design1将保留在堆栈内存中。尝试将activesheet作为函数的参数。

Answer 2

我认为错误是因为您的代码更改了工作表，因此调用了一个新事件。要确保是这种情况，请执行以下操作 - 在事件上插入STOP，如下所示：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.ScreenUpdating = False
    Stop

    Dim var1 As Variant
    'rest of your code.
End Sub

第一次进行选择更改时，您将停止停止。然后按 F5 并继续。如果再次停止，那么它是一个递归错误。

最简单的解决方法是在活动开始时使用Application.EnableEvents = False，在代码末尾使用Application.EnableEvents = True。

不一致地“超出堆栈空间”错误

2 个答案: