excel 用于验证和格式化文本框中日期输入的VBA代码

zbq4xfa0  于 2023-03-24  发布在  其他
关注(0)|答案(1)|浏览(182)

该代码的目的是将名为Zeitw的文本框中的用户输入格式化为有效的日期格式(dd.MM.yyyy)。每当用户更改文本框中的文本时,都会执行该代码。该代码会检查输入是否包含日期分隔符(句点)。如果缺少日期分隔符,则代码会将其添加到适当的位置。
接下来,代码从输入字符串中提取日、月和年,并检查是否可以使用内置的IsDate函数将其转换为有效日期,从而检查日期是否有效。如果日期无效,或者日或月的值超出了预期范围,则清除文本框并向用户显示错误消息。
最后,代码用格式化的输入更新文本框。

Private Sub Zeitw_Change()
    Dim inputt As String
    inputt = Zeitw.Text

    ' Check if the input is numeric
    If Not IsNumeric(inputt) Then
        Zeitw.Text = ""
        Exit Sub
    End If

    ' Add the date separators
    If Len(inputt) = 2 And InStr(inputt, ".") = 0 Then
        inputt = inputt & "."
    ElseIf Len(inputt) = 5 And InStr(inputt, ".", 3) = 0 Then
        inputt = inputt & "."
    End If

    ' Check if the date is valid
    If Len(inputt) = 10 Then
        Dim day As Integer
        Dim month As Integer
        Dim year As Integer
        day = Val(Mid(inputt, 1, 2))
        month = Val(Mid(inputt, 4, 2))
        year = Val(Right(inputt, 4))
        If Not IsDate(day & "." & month & "." & year) Then
            Zeitw.Text = ""
            MsgBox "Please enter a valid date.(tt.mm.jjjj)", vbExclamation, "Invalid Date"
            Exit Sub
        ElseIf day > 31 Or month > 12 Then
            Zeitw.Text = ""
            MsgBox "Please enter a valid date.(tt.mm.jjjj)", vbExclamation, "Invalid Date"
            Exit Sub
        End If
    End If

    ' Check if the year is valid
    Dim minYear As Integer
    minYear = 1900
    Dim maxYear As Integer
    maxYear = 2099
    Dim yearValue As Integer
    yearValue = Val(Right(inputt, 4))
    If yearValue < minYear Or yearValue > maxYear Then
        Zeitw.Text = ""
        MsgBox "Please enter a valid year.(tt.mm.jjjj)", vbExclamation, "Invalid Year"
        Exit Sub
    End If

    ' Update the textbox value
    Zeitw.Text = inputt
End Sub

所需的输出是文本框中格式正确的日期,该日期有效且可供程序使用。用户遇到的问题是,当他们输入以0开头的日期(例如01.03.2023)时,出现错误。错误为
无效的过程调用和参数。
最后,调试器显示ElseIf Len(inputt) = 5 And InStr(inputt, ".", 3) = 0 Then行。

ryevplcw

ryevplcw1#

如果这些点是可选的,则在检查之前将其删除。

Option Explicit

Private Sub Zeitw_Change()
    
    Const minYear = 1900
    Const maxYear = 2099
    
    Dim inputt As String, s As String, dt As Date
    Dim ymd As String, msg As String, title As String
    
    ' remove any dots
    inputt = Zeitw.Text
    s = Replace(inputt, ".", "")

    ' Check if the input is 8 digits after dots removed
    If s Like "########" Then
       ymd = Right(s, 4) & "-" & Mid(s, 3, 2) & "-" & Left(s, 2)
       ' check valid date
       If IsDate(ymd) Then
            dt = DateValue(ymd)
            If year(dt) < minYear Or year(dt) > maxYear Then
                msg = "Year " & year(dt) & " must be between " & minYear & " and " & maxYear
                title = "Invalid year"
            End If
       Else
            msg = "Please enter a valid date (tt.mm.jjjj)"
            title = "Invalid date : " & inputt
       End If
    Else
        msg = "Please enter a valid date (tt.mm.jjjj)"
        title = "Invalid date format : " & inputt
    End If
       
    ' check result
    If msg = "" Then
        ' format with dots
        Zeitw.Text = Format(dt, "dd.mm.yyyy")
    Else
        Zeitw.Text = ""
        MsgBox msg, vbExclamation, title
    End If

End Sub

相关问题