Banniere defilente

exceltony

XLDnaute Nouveau
Bonjour à tous Excelien et excelienne,

Je cherche a creer une banniere defilente, mais mon niveau en excel ne me permet pas de le faire, je fais donc appel a vos talents!!

Je vous ai joint un fichier avec mes besoins, mais aucune macro de creee.
C'est une macro que je souhaite affecter a d'autre classeur si besoin.

Merci d'avance.
 

Pièces jointes

  • TEXTE DEFILENT.xlsm
    8.4 KB · Affichages: 61
  • TEXTE DEFILENT.xlsm
    8.4 KB · Affichages: 68
  • TEXTE DEFILENT.xlsm
    8.4 KB · Affichages: 67

Theze

XLDnaute Occasionnel
Re : Banniere defilente

Bonjour,

Regarde si c'est ce que tu cherche. Le texte défilant se trouve en "A1" de "Feuil2" et est reporté en "A10" de "Feuil1" Voici le code en plus du classeur :
Code:
'API
Private Declare Function GetTickCount _
                         Lib "Kernel32" () As Long

Dim ArretDefil As Boolean
Dim Texte As String

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
        
        'régler le sens du défilement "Gauche" ou "Droite"
        Message "Droite"
        
    Loop

End Sub

Sub Message(Sens As String)

    Dim Chaine1 As String
    Dim Chaine2 As String
    
    'Faire défiler un texte dans la cellule
    'vers la droite ou vers la gauche
    With Worksheets("Feuil2").Range("A1")
    
        If Sens = "Droite" Then
        
            Chaine2 = Left(.Value, 1)
            Chaine1 = Right(.Value, Len(.Value) - 1) & Chaine2
            .Value = Chaine1
            
        ElseIf Sens = "Gauche" Then
        
            Chaine2 = Right(.Value, 1)
            Chaine1 = Chaine2 & Left(.Value, Len(.Value) - 1)
            .Value = Chaine1
            
        End If
        
    End With

End Sub

'Subs appelées par les bouton
Sub Marche()

    ArretDefil = False
    
    Chrono

End Sub

Sub Arret()
                                
    ArretDefil = True

End Sub

Hervé.
 

Pièces jointes

  • TEXTE DEFILENT.xlsm
    18.7 KB · Affichages: 83
  • TEXTE DEFILENT.xlsm
    18.7 KB · Affichages: 87
  • TEXTE DEFILENT.xlsm
    18.7 KB · Affichages: 81

Statistiques des forums

Discussions
312 450
Messages
2 088 511
Membres
103 873
dernier inscrit
Sabin