Excel VBA 运行时错误 9，但在单步执行代码时没有

Question

带有 EventHandler 类的 VBA 用户表单抛出运行时错误“9”的原因是什么：下标超出范围

但是

如果我按 F8 并进入用户窗体代码，我可以直接通过整个代码而不会崩溃

为了简单起见，这里是我的事件处理程序类 LabelEventHandler

Private WithEvents Innerlabel As MSForms.Label

Private InnerRow As Integer
Private InnerSheet As Worksheet

Public Property Set Label(ByVal InLabel As MSForms.Label)
    Set Innerlabel = InLabel
End Property

Public Property Let Row(ByVal InRow As Integer)
    InnerRow = InRow
End Property

Public Property Set Sheet(ByVal InSheet As Worksheet)
    Set InnerSheet = InSheet
End Property

Private Sub InnerLabel_Click()
    Dim Frame As MSForms.Frame
    Dim ChildLabel As MSForms.Label
    Set Frame = Innerlabel.Parent
    For Each ChildLabel In Frame.Controls
        Select Case ChildLabel.Name
            Case "FullName"
                InnerSheet.Cells(InnerRow, 4).Value = ChildLabel.Caption
            Case "Email"
                InnerSheet.Cells(InnerRow, 5).Value = ChildLabel.Caption
            Case "Phone"
                InnerSheet.Cells(InnerRow, 6).Value = ChildLabel.Caption
        End Select
    Next
 End Sub

这是用户窗体代码

Private Sheet As Worksheet

Private LabelClickArray() As New LabelEventHandler

Public Sub AddUser(FullName As String, Email As String, Phone As String)
    Dim FullNameLabel As MSForms.Label
    Dim EmailLabel As MSForms.Label
    Dim PhoneLabel As MSForms.Label
    Dim UserFrame As Frame
    Dim Top
    Top = FindBottomUserRow()
    Set UserFrame = Me.Controls.Add("Forms.Frame.1")

    With UserFrame
        .Top = Top
        .Left = 5
        .Width = 660
        .Height = 20
        .Font.Name = "Verdana"
        .Font.Size = 12
        .Font.Weight = 400
        .Caption = ""
        .BorderStyle = fmBorderStyleNone
    End With

    Set FullNameLabel = UserFrame.Controls.Add("Forms.Label.1")
    Set EmailLabel = UserFrame.Controls.Add("Forms.Label.1")
    Set PhoneLabel = UserFrame.Controls.Add("Forms.Label.1")

    With FullNameLabel
        .Top = 0
        .Left = 0
        .Width = 200
        .Height = 15
        .Name = "FullName"
        .Caption = FullName
    End With
    With EmailLabel
        .Top = 0
        .Left = 205
        .Width = 300
        .Height = 15
        .Name = "Email"
        .Caption = Email
    End With
    With PhoneLabel
        .Top = 0
        .Left = 510
        .Width = 150
        .Height = 15
        .Name = "Phone"
        .Caption = Phone
    End With

    ReDim Preserve LabelClickArray(UBound(LabelClickArray) + 3)

    Set LabelClickArray(UBound(LabelClickArray) - 2).Label = FullNameLabel
    Set LabelClickArray(UBound(LabelClickArray) - 1).Label = EmailLabel
    Set LabelClickArray(UBound(LabelClickArray)).Label = PhoneLabel

    Set LabelClickArray(UBound(LabelClickArray) - 2).Sheet = Sheet
    Set LabelClickArray(UBound(LabelClickArray) - 1).Sheet = Sheet
    Set LabelClickArray(UBound(LabelClickArray)).Sheet = Sheet

    LabelClickArray(UBound(LabelClickArray) - 2).Row = ActiveCell.Row
    LabelClickArray(UBound(LabelClickArray) - 1).Row = ActiveCell.Row
    LabelClickArray(UBound(LabelClickArray)).Row = ActiveCell.Row
End Sub


Function FindBottomUserRow()
    Dim Frame As Control
    Dim Top
    Top = 30
    For Each Frame In Me.Controls
        If (TypeName(Frame) = "Frame" And Frame.Top > Top) Then Top = Frame.Top
    Next
    If (Top > 30) Then Top = Top + 20
    FindBottomUserRow = Top
End Function

Private Sub UserForm_Initialize()
    Set Sheet = ActiveSheet
    Me.AddUser "Ryan", "ryan@r.com", "2625"
    Me.AddUser "Jeff", "j@k.com", "123-4567"
End Sub

错误

Answer 1

您的错误发生在ReDim Preserve 命令中，因为您从未初始化数组。您不能对未初始化的数组执行UBound-函数（如果您尝试，则会收到运行时错误 9）。如果您在运行时无法确定您的数组是否已经初始化，请将您的代码更改为：

If IsArrayAllocated(LabelClickArray) Then
    ReDim Preserve LabelClickArray(UBound(LabelClickArray) + 3)
Else
    ReDim LabelClickArray(3)
End If

函数IsArrayAllocated 如下所示：

Function IsArrayAllocated(arr As Variant) As Boolean

    On Error Resume Next
    IsArrayAllocated = IsArray(arr) _
                   And Not IsError(LBound(arr, 1)) _
                   And LBound(arr, 1) <= UBound(arr, 1)

End Function

（复制自cpearson的代码）