Question

我建立了一个vba代码，当按下工作表按钮时，它将打开一个用户窗体，并在运行时在其中填充一些控件。这些控件是一堆标签，文本框和按钮。对于需要日期值的文本框，在运行时也会在其旁边创建一个日历按钮。

用户第一次打开用户窗体时，可以重复按下日历按钮而不会出现错误，并且文本框将以选定的日期保持完整。但是，如果用户使用“ X”（关闭）按钮退出用户表单，再次打开用户表单，按下日历按钮并单击日期标签，则会出现以下措辞触发错误：

运行时错误'-2147418113（8000ffff）'：自动化错误

在我用于处理日期标签点击事件的类的简化代码下面找到。

我没有在网上搜索解决方案。我还清除了所有代码，进行了编译，然后将代码放回原处，但没有任何更改。

Option Explicit

Public WithEvents InputLabel As MSForms.Label
Public originTB As Controls

Private Sub InputLabel_click()

    Dim cal_ParentForm_text As String
    Dim cal_ParentCtrl_text As String
    Dim cal_ParentTB As String
    Dim ctl As Control
    Dim count As Integer
    Dim myWords As String
    Dim word As String
    Dim i As Long
    Dim tag_len As Integer


    lFirstDay = Val(InputLabel.Caption)

    'Form_calendar.tag STRUCTURE: FORM,FRAME,TEXTBOXNAME
    count = 0
    word = ""
    myWords = Form_calendar.Tag
    tag_len = Len(myWords)
    For i = 1 To tag_len
        If Mid(myWords, i, 1) = "," Or i = tag_len Then 'End of word
            count = count + 1
            Select Case count
                Case 1 'Form
                    cal_ParentForm_text = word
                    word = ""
                Case 2 'Frame
                    cal_ParentCtrl_text = word
                    word = ""
                Case 3 'TextBoxName
                    cal_ParentTB = word & Mid(myWords, i, 1)
            End Select
        Else
            word = word & Mid(myWords, i, 1)
        End If
    Next i


    'Look for the origin textbox within calendar textbox collection (coll_CalTextBox)
    For Each ctl In coll_CalTextBox
        If ctl.Name = cal_ParentTB Then

            'FOLLOWING LINE TRIGGERS THE ERROR
            ctl.Text = Format(ReturnDate(lFirstDay, lSelMonth, lSelYear), "Short Date")

        End If
    Next ctl

    Unload Form_calendar

End Sub


Function ReturnDate(ByVal lDay As Long, ByVal lMonth As Long, ByVal lYear As Long) As Date
'Returns the date with day, month and year in
'the sequence defined by the system's settings.

    Dim lDayPos As Long              'Day position in date
    Dim lMonthPos As Long            'Month position in date

    lDayPos = Day("01-02-03")
    lMonthPos = Month("01-02-03")

    If lDayPos = 1 And lMonthPos = 2 Then
       ReturnDate = lDay & "/" & lMonth & "/" & lYear
    'AFTER THIS STATEMENT THE ERROR IS TRIGGERED
       Exit Function

    ElseIf lDayPos = 2 And lMonthPos = 1 Then
       ReturnDate = lMonth & "/" & lDay & "/" & lYear
       Exit Function
    ElseIf lDayPos = 3 And lMonthPos = 2 Then
       ReturnDate = lYear & "/" & lMonth & "/" & lDay
       Exit Function
    ElseIf lDayPos = 2 And lMonthPos = 3 Then
       ReturnDate = lYear & "/" & lDay & "/" & lMonth
       Exit Function
    ElseIf lDayPos = 1 And lMonthPos = 3 Then
       ReturnDate = lDay & "/" & lYear & "/" & lMonth
       Exit Function
    ElseIf lMonthPos = 1 And lDayPos = 3 Then
       ReturnDate = lMonth & "/" & lYear & "/" & lDay
    End If

End Function

我第二次打开用户表单并按日历按钮，

0 个答案: