如何基于UserForm中Paid On文本框日期设置会员状态文本框值

Hey Alex! Welcome to VBA and thanks for posting your question. Let's build this step by step so you can easily implement it.

First, let's align on your stated requirements (I'll code exactly what you specified first, then add a key note at the end to adjust for the 12-month validity period if that's what you actually need):

• If the Paid On textbox is empty → status shows No Payment Made
• If the Paid On date is earlier than today → status shows Active
• If the Paid On date is later than today → status shows Expired
• Finally, we’ll write these values to the DB worksheet (Column G = membership status, Column H = Paid On date)

Step 1: Confirm Your UserForm Controls #

I’ll assume your UserForm has these elements:

• A textbox named txtPaidOn (for entering the payment date)
• A textbox named txtStatus (to display the calculated membership status)
• A command button named btnSave (to trigger the calculation and save data to Excel)

Step 2: Add VBA Code to the UserForm #

Double-click the btnSave button to open the code editor, then paste this code:

Private Sub btnSave_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim paidOnDate As Date
    Dim isValidDate As Boolean
    
    ' Link to the "DB" worksheet
    Set ws = ThisWorkbook.Worksheets("DB")
    
    ' Find the next empty row in the DB sheet
    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row + 1
    
    ' Handle empty Paid On textbox first
    If Trim(txtPaidOn.Value) = "" Then
        txtStatus.Value = "No Payment Made"
        ' Write status to Column G, leave Column H empty
        ws.Cells(lastRow, "G").Value = txtStatus.Value
        ws.Cells(lastRow, "H").ClearContents
        Exit Sub
    End If
    
    ' Check if the input is a valid date
    On Error Resume Next
    paidOnDate = CDate(txtPaidOn.Value)
    isValidDate = (Err.Number = 0)
    On Error GoTo 0
    
    If Not isValidDate Then
        MsgBox "Please enter a valid date in the 'Paid On' field!", vbExclamation
        txtPaidOn.SetFocus
        Exit Sub
    End If
    
    ' Calculate membership status per your rules
    If paidOnDate < Date Then
        txtStatus.Value = "Active"
    ElseIf paidOnDate > Date Then
        txtStatus.Value = "Expired"
    Else
        ' If Paid On date is exactly today, default to Active (adjust if needed)
        txtStatus.Value = "Active"
    End If
    
    ' Save values to the DB worksheet
    ws.Cells(lastRow, "G").Value = txtStatus.Value
    ws.Cells(lastRow, "H").Value = paidOnDate
    ' Format the date column for readability (adjust format as needed)
    ws.Cells(lastRow, "H").NumberFormat = "mm/dd/yyyy"
    
    ' Optional: Clear textboxes after saving
    txtPaidOn.Value = ""
    txtStatus.Value = ""
    MsgBox "Membership status saved successfully!", vbInformation
End Sub

Step 3: (Optional) Real-Time Status Updates #

If you want the status to update automatically as soon as the user types a date (no button click needed), add this code to the txtPaidOn_Change event:

Private Sub txtPaidOn_Change()
    Dim paidOnDate As Date
    Dim isValidDate As Boolean
    
    ' Handle empty textbox
    If Trim(txtPaidOn.Value) = "" Then
        txtStatus.Value = "No Payment Made"
        Exit Sub
    End If
    
    ' Validate date input
    On Error Resume Next
    paidOnDate = CDate(txtPaidOn.Value)
    isValidDate = (Err.Number = 0)
    On Error GoTo 0
    
    If Not isValidDate Then
        txtStatus.Value = "Invalid Date"
        Exit Sub
    End If
    
    ' Calculate status in real time
    If paidOnDate < Date Then
        txtStatus.Value = "Active"
    ElseIf paidOnDate > Date Then
        txtStatus.Value = "Expired"
    Else
        txtStatus.Value = "Active"
    End If
End Sub

Critical Adjustment for 12-Month Validity #

You mentioned memberships are valid for 12 months, but your original rule only compares the Paid On date directly to today. That probably isn’t what you intended!

For example, if someone paid on 2023-10-01, their membership should stay active until 2024-10-01—not just because the paid date is before today. If that’s the case, replace the status calculation section with this code:

' Calculate status based on 12-month validity period
If DateAdd("m", 12, paidOnDate) >= Date Then
    txtStatus.Value = "Active"
Else
    txtStatus.Value = "Expired"
End If

This checks if the paid date plus 12 months falls on or after today, which aligns with a standard 12-month membership term.

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