余小章 @ 大內殿堂

Option Explicit
Dim di As Date
Dim dDiffDay As Long
Dim dDiffHour As Long
Dim dDiffMin As Long
Dim dDiffSec As Long
Private Sub Command1_Click()
    Command1.Enabled = False
    Command2.Enabled = True
    Dim dNow As Date
    If IsDate(Text1.Text) = True Then
        di = CDate(Text1.Text)
        Call Diff(dDiffDay, dDiffHour, dDiffMin, dDiffSec)
        If (dDiffDay < 0 Or dDiffHour < 0 Or dDiffMin < 0 Or dDiffSec < 0) = True Then
            MsgBox "輸入時間已過，請重新輸入"
            Command1.Enabled = True
            Command2.Enabled = False
            Exit Sub
        End If
    End If
    Timer1.Interval = 1
    Timer1.Enabled = True
End Sub
Private Function Diff(ByRef d As Variant, ByRef h As Variant, ByRef m As Variant, ByRef s As Variant)
    On Error GoTo ToExit
    '------------------------------------------------
    d = DateDiff("d", Now, di) '取相差天數
    h = CLng(DateDiff("h", Now, di)) Mod 24 '取相差時數
    m = CLng(DateDiff("n", Now, di)) Mod 60 '取相差分數
    s = CLng(DateDiff("s", Now, di)) Mod 60 '取相差秒數
    
    '------------------------------------------------
    Exit Function
    '----------------
ToExit:
    MsgBox "日期格式輸入錯誤"
    'Resume Next
    Timer1.Enabled = False
End Function
Private Sub Command2_Click()
    Timer1.Enabled = False
    Command1.Enabled = True
    Command2.Enabled = False
End Sub
Private Sub Form_Load()
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Private Sub Timer1_Timer()
    Timer1.Interval = 1000
    Call Diff(dDiffDay, dDiffHour, dDiffMin, dDiffSec)
    If dDiffDay = 0 And dDiffHour = 0 And dDiffMin = 0 And dDiffSec = 0 Then '時間到!!!
        MsgBox "新年快樂!!!"
        MsgBox "輸入時間已過，請重新輸入"
        Timer1.Enabled = False
        Exit Sub
    Else
        Label1.Caption = "距離 " & Text1 & " 還剩" & _
                         CStr(dDiffDay) & " 天" & _
                         CStr(dDiffHour) & " 小時" & _
                         CStr(dDiffMin) & " 分" & _
                         CStr(dDiffSec) & " 秒"
    End If
End Sub