Dim Ende As Date
 
Private Function DatDiff(datStart As Date, datEnd As Date) As String
 
Dim intYear As Integer, intMonth As Integer
Dim intYD As Integer, intMD As Integer, intWD As Integer, intTD As Integer
Dim intHD As Integer, intND As Integer, intSD As Integer
 
If DateDiff("s", Now, datEnd) >= 0 Then
 
intYear = Year(datStart)
intMonth = Month(datStart)
 
intYD = Year(datEnd) - intYear
intMD = Month(datEnd) - intMonth
intTD = Day(datEnd) - Day(datStart)
intHD = Hour(datEnd) - Hour(datStart)
intND = Minute(datEnd) - Minute(datStart)
intSD = Second(datEnd) - Second(datStart)
 
If intSD < 0 Then
   intND = intND - 1
   intSD = intSD + 60
End If
 
If intND < 0 Then
   intHD = intHD - 1
   intND = intND + 60
End If
 
If intHD < 0 Then
   intTD = intTD - 1
   intHD = intHD + 24
End If
 
If intTD < 0 Then
   intMD = intMD - 1
   intTD = intTD + Day(DateSerial(intYear, intMonth + 1, 0))
End If
 
intWD = Int(intTD / 7)
intTD = intTD - (intWD * 7)
 
If intMD < 0 Then
   intYD = intYD - 1
   intMD = intMD + 12
End If
 
Else
Timer1.Enabled = False
DatDiff = "Es ist geschafft, Contdown beendet !"
Exit Function
End If
 
DatDiff = "Es sind noch: " & vbCrLf & vbCrLf _
& intYD & " Jahr(e) und " & intMD & " Monat(e) und " & intWD & " Woche(n) und " _
& intTD & " Tag(e)" & vbCrLf & vbCrLf _
& intHD & " Stunde(n) und " & intND & " Minute(n) und " & intSD & " Sekunde(n)"
End Function
 
Private Sub Form_Load()
Label1.Move 100, 100, 5000, 2000
Label1.Caption = ""
Timer1.Interval = 1000
Ende = "10.04.2005 18:30:00"
End Sub
 
Private Sub Timer1_Timer()
Label1.Caption = DatDiff(Now, Ende)
End Sub