also ich habe versucht in einer powerpoint-p einen countdown einzubauen DD:HH:MM:SS das hat auch soweit funktioniert aber dann bin ich draufgekommen das er mir nach dem erst durchgang die diff der tage beibehält und nciht mehr ändert.  Stunden, Minuten, Sekund funktioniert super aber die tage werden nicht neu berechnet.Kann mir da jemand helfen den fehler zu finden.

Danke schonmal SNuu

Option Explicit
'API Declarations
Declare Function SetTimer Lib "user32" _
                            (ByVal hwnd As Long, _
                             ByVal nIDEvent As Long, _
                             ByVal uElapse As Long, _
                             ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" _
                            (ByVal hwnd As Long, _
                             ByVal nIDEvent As Long) As Long
 
' Public Variables
Public TimerID As Long
Public bTimerState As Boolean
Public Const TargetDateTime As Date = "01/10/2013 23:59:59"


Sub TimerOnOff()
If bTimerState = False Then
    TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
    If TimerID = 0 Then
        MsgBox "Unable to create the timer", vbCritical + vbOKOnly, "Error"
        Exit Sub
    End If
    bTimerState = True
Else
    TimerID = KillTimer(0, TimerID)
    If TimerID = 0 Then
        MsgBox "Unable to stop the timer", vbCritical + vbOKOnly, "Error"
    End If
    bTimerState = False
End If
End Sub
 
' The defined routine gets called every nnnn milliseconds.
Sub TimerProc(ByVal hwnd As Long, _
                    ByVal uMsg As Long, _
                    ByVal idEvent As Long, _
                    ByVal dwTime As Long)

Dim diff As Date
Dim out As String
Dim maxshapes As Integer
Dim i As Integer

diff = TargetDateTime - Now
out = ""
If CInt(diff) <> 0 Then
    out = out + CStr(CInt(diff))
    If CInt(diff) = 1 Then
        out = out + " day "
    Else
        out = out + " days "
    End If
End If

    out = out + CStr(Hour(diff))
    If Hour(diff) > 1 Then
        out = out + " hours "
    Else
        out = out + " hour "
    End If

    out = out + CStr(Minute(diff))
    If Minute(diff) > 1 Then
        out = out + " Min "
    Else
        out = out + " Min "
    End If

    out = out + CStr(Second(diff))
    If Second(diff) > 1 Then
        out = out + " Sec"
    Else
        out = out + " Sec"
    End If

On Error GoTo err:
For i = 1 To ActivePresentation.Slides.Count
    maxshapes = ActivePresentation.Slides(i).Shapes.Count
    
    ActivePresentation.Slides(i).Shapes(maxshapes).TextFrame.TextRange.Text = out
Next i

err:

End Sub