Private 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
  Label1.FontSize = 26
  DatDiff = "Es ist soweit, frohes neues Jahr 2006 !"
  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.FontSize = 8
  Label1.Caption = ""
  Timer1.Interval = 1000
  Ende = "01.01.06 00:00:00"
End Sub
 
Private Sub Timer1_Timer()
  Label1.Caption = DatDiff(Now, Ende)
End Sub