Ruban de téléscripteur défilant

Private Declare Function GetTickCount _
                         Lib "Kernel32" () As Long

Dim ArretDefil As Boolean

Private Sub Minuterie(Milliseconde As Long)

    Dim Arret As Long
    
    Arret = GetTickCount() + Milliseconde
    
    Do While GetTickCount() < Arret
    
        DoEvents
        
    Loop

End Sub

Private Sub Chrono()

    Do
        If ArretDefil = True Then Exit Do
            'régler ici la vitesse en modifiant
            'la valeur (en millisecondes)
        Minuterie 100
        Message
        
    Loop

End Sub

Private Sub Message()

    Dim Chaine1 As String
    Dim Chaine2 As String

    With Range("J4")
    
        Chaine2 = Left(.Value, 1)
        Chaine1 = Right(.Value, Len(.Value) - 1) & Chaine2
        .Value = Chaine1
        
    End With

End Sub


Public Sub MarcheArret()

    'des clics successifs arrêtent ou démarrent le défilement
    ArretDefil = Not ArretDefil
    
    Range("J4") = Range("J10").Value & Range("J11").Value & Range("J12").Value
    
    Chrono

End Sub