VBA UserForm调用报错：Object Required，表单无法初始化求助

我在通过模块调用UserForm时遇到异常：执行INSERT_TASK_FORM.Show时提示“Object Required”错误，表单无法完成初始化。调用方式和另一可正常运行的工作簿完全一致。

按钮绑定的模块代码 #

Sub SHOW_INSERT_TASK_FORM()
    INSERT_TASK_FORM.Show ' 错误发生在此处
End Sub

该代码本应初始化INSERT_TASK_FORM并执行其内部代码，但调用Show方法时触发错误。

用户表单内嵌代码 #

Private Sub SUBMIT_BUTTON_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    'DECLARE OBJECT VARIABLES
    Dim planner_ws As Worksheet, data_ws As Worksheet
    Dim departments As ListObject
    Dim types As ListObject
    Dim tasks As ListObject
    Dim dep_arr() As Variant
    Dim type_arr() As Variant
    Dim task_arr() As Variant
    Dim i As Double, j As Double, x As Double
    Dim lrow As Double, srow As Double

    'SET WS VARIABLES
    Set planner_ws = ThisWorkbook.Worksheets("TASK_PLANNER")
    Set data_ws = ThisWorkbook.Worksheets("DATA")

    'ASSIGN OBJECT VARIABLES
    Set departments = data_ws.ListObjects("DEPARTMENT_TABLE")
    Set types = data_ws.ListObjects("TASK_TYPE_TABLE")
    Set tasks = data_ws.ListObjects("TASKS_TABLE")

    'ASSIGN VARIABLE VALUES
    dep_arr = departments.DataBodyRange
    type_arr = types.DataBodyRange
    task_arr = tasks.DataBodyRange
    lrow = planner_ws.Cells(planner_ws.Rows.Count, 2).End(xlUp).Row

    'INITIAL USER FORM VALUES
    TASK_NAME_TBOX.Value = ""
    DESC_TBOX.Value = ""
    SDATE_TBOX.Value = ""
    EDATE_TBOX.Value = ""

    Task_Option = False
    Sub_Option = False

    'POPULATE COMBO BOXES
    With TYPE_CBOX
        For i = LBound(type_arr) To UBound(type_arr)
            .AddItem type_arr(i, types.ListColumns("Task_Type").Index)
        Next i
    End With

    With DEP_CBOX
        For i = LBound(dep_arr) To UBound(dep_arr)
            .AddItem dep_arr(i, types.ListColumns("Department").Index)
        Next i
    End With

    With TASK_CBOX
        For i = LBound(task_arr) To UBound(task_arr)
            .AddItem task_arr(i, types.ListColumns("Task Name").Index)
        Next i
    End With
End Sub

Private Sub SUB_OPTION_Click()
    If Sub_Option.Value = True Then
        Task_Label.Visible = True
        TASK_CBOX.Visible = True
    Else
        Task_Label.Visible = False
        TASK_CBOX.Visible = False
    End If
End Sub

参考的正常运行代码 #

另一工作簿中可正常运行的代码示例：

Sub GameSale_Form()
    xInput_GameSale.Show
End Sub

Private Sub UserForm_Initialize()
    LCS_Option = False
    NOTLCS_Option = False

    Qty_TextBox.Value = ""
    Discount_TextBox.Value = ""
    InputCost_Textbox.Value = ""

    InRegion_Option.Value = False
    NotInRegion_Option = False

    New_Option.Value = False
    Used_Option.Value = False

    InputCost_Option = False
    AvCost_Option = False

    FDAPricing_Option = False
    NoFDAPricing_Option = False

    With Cabinet_Combobox
        For i = 2 To ThisWorkbook.Worksheets("List_Data").Cells(Rows.Count, 36).End(xlUp).Row
            .AddItem ThisWorkbook.Worksheets("List_Data").Cells(i, 36).Value
        Next i
    End With

    Opening_Textbox.Value = ""
    Ambition_Textbox.Value = ""
    Goal_Textbox.Value = ""
    WalkAway_Textbox.Value = ""

    Qty_SpinButton.Min = 0
    Qty_SpinButton.Max = 1000
End Sub

错误排查与解决方案 #

1. 修正ListObject列引用错误
   表单初始化代码中存在明显的列引用混淆：填充DEP_CBOX时用了types.ListColumns（对应TASK_TYPE_TABLE），而非departments.ListColumns（对应DEPARTMENT_TABLE）；填充TASK_CBOX时同理，错误引用了types表的列索引。这会导致找不到对应列时返回Nothing，触发“Object Required”错误。

   修正后的代码片段：

   ' 修正DEP_CBOX的列引用
   With DEP_CBOX
       For i = LBound(dep_arr) To UBound(dep_arr)
           .AddItem dep_arr(i, departments.ListColumns("Department").Index)
       Next i
   End With
   
   ' 修正TASK_CBOX的列引用
   With TASK_CBOX
       For i = LBound(task_arr) To UBound(task_arr)
           .AddItem task_arr(i, tasks.ListColumns("Task Name").Index)
       Next i
   End With
   

2. 添加ListObject空值判断
   如果departments、types或tasks表没有数据，DataBodyRange会返回Nothing，直接赋值给数组会触发错误。需添加判断逻辑：

   ' 给数组赋值前检查DataBodyRange是否存在
   If Not departments.DataBodyRange Is Nothing Then
       dep_arr = departments.DataBodyRange
   Else
       ReDim dep_arr(1 To 1, 1 To 1)
   End If
   
   If Not types.DataBodyRange Is Nothing Then
       type_arr = types.DataBodyRange
   Else
       ReDim type_arr(1 To 1, 1 To 1)
   End If
   
   If Not tasks.DataBodyRange Is Nothing Then
       task_arr = tasks.DataBodyRange
   Else
       ReDim task_arr(1 To 1, 1 To 1)
   End If
   

3. 验证控件名称一致性
   检查表单中控件名称（如Task_Option、Sub_Option、TYPE_CBOX等）是否与代码中引用的完全匹配，名称不匹配也会导致对象引用错误。

内容的提问来源于stack exchange，提问作者CostcoGridlock