OVH Cloud OVH Cloud

LABEL DEFILEMENT

2 réponses
Avatar
PTIFRED
Bonjours
dans un userform je voudrai savoir si c'est possible de
faire defiller un texte (de gauche a droite ou inverse) de
presentation
par avance merci

2 réponses

Avatar
Hervé
Salut,
En utilisant un Label, adapte :

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

Public 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

Sub Message()
Dim Chaine1 As String
Dim Chaine2 As String

'Faire défiler un Label dans un Frame
'ou une Form
'With Label1
' 'régler ici la vitesse
' '(réglage aussi dans la proc Chrono)
' .Left = .Left - 4 '10
' If .Left + .Width < 0 Then
' 'dans la Form
' .Left = Me.Width
' 'Dans un Frame
' '.Left = Frame1.Width
' End If
'End With

'Faire défiler un texte dans un Label
With Label1
Chaine2 = Left(.Caption, Len(Texte) - Len(.Caption) + 1)
Chaine1 = Right(.Caption, Len(.Caption) - 1) & Chaine2
.Caption = Chaine1
End With

End Sub

Private Sub UserForm_Activate()
Chrono
End Sub

Private Sub UserForm_Click()
ArretDefil = Not ArretDefil
'des clics successifs arrêtent
'ou démarrent le défilement en
'fonction de la valeur d'ArretDefil
Chrono
End Sub

Private Sub UserForm_Initialize()
Texte = "Voici un message " & _
"défilant pour animer et " & _
"attirer l'attention !" & Space(5)
With Label1
.Caption = Texte
.Font.Bold = True
End With
End Sub

Hervé.

"PTIFRED" a écrit dans le message news:
2f1201c47e3f$e97d29f0$
Bonjours
dans un userform je voudrai savoir si c'est possible de
faire defiller un texte (de gauche a droite ou inverse) de
presentation
par avance merci




Avatar
Hervé
Re,
Je te reposte les procs que je viens de modifiées pour un défilement vers la
droite ou vers la gauche. Il te suffit pour cela de préciser le sens dans la
proc "Chrono" :

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

Public Sub Chrono()
Do
If ArretDefil = True Then Exit Do
'régler ici la vitesse en modifiant
'la valeur (en millisecondes)
Minuterie 100
'indiquer le sens de déffilement
Message "Droite"
Loop
End Sub

Sub Message(Sens As String)
Dim Chaine1 As String
Dim Chaine2 As String

'Faire défiler un Label dans un Frame
'ou une Form vers la droite ou vers la gauche
'With Label1
' If Sens = "Droite" Then
' .Left = .Left + 4 'régler ici la vitesse
' If .Left > Me.Width Then
' 'dans la Form
' .Left = 0 - .Width
' 'dans un Frame
' ' .Left = 0 - Frame1.Width
' End If
' ElseIf Sens = "Gauche" Then
' .Left = .Left - 4 'régler ici la vitesse
' If .Left + .Width < 0 Then
' 'dans la Form
' .Left = Me.Width
' 'dans un Frame
' ' .Left = Frame1.Width
' End If
' End If
'End With

'Faire défiler un texte dans un Label
'vers la droite ou vers la gauche
With Label1
If Sens = "Droite" Then
Chaine2 = Left(.Caption, 1)
Chaine1 = Right(.Caption, Len(.Caption) - 1) & Chaine2
.Caption = Chaine1
ElseIf Sens = "Gauche" Then
Chaine2 = Right(.Caption, 1)
Chaine1 = Chaine2 & Left(.Caption, Len(.Caption) - 1)
.Caption = Chaine1
End If
End With

End Sub

Private Sub UserForm_Activate()
Chrono
End Sub

Private Sub UserForm_Click()
ArretDefil = Not ArretDefil
'des clics successifs arrêtent
'ou démarrent le défilement en
'fonction de la valeur d'ArretDefil
Chrono
End Sub

Private Sub UserForm_Initialize()
Texte = "Voici un message " & _
"défilant pour animer et " & _
"attirer l'attention !" & Space(5)
With Label1
.Caption = Texte
.Font.Bold = True
End With
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
ArretDefil = True
End Sub

Hervé.

"Hervé" a écrit dans le message news:

Salut,
En utilisant un Label, adapte :

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

Public 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

Sub Message()
Dim Chaine1 As String
Dim Chaine2 As String

'Faire défiler un Label dans un Frame
'ou une Form
'With Label1
' 'régler ici la vitesse
' '(réglage aussi dans la proc Chrono)
' .Left = .Left - 4 '10
' If .Left + .Width < 0 Then
' 'dans la Form
' .Left = Me.Width
' 'Dans un Frame
' '.Left = Frame1.Width
' End If
'End With

'Faire défiler un texte dans un Label
With Label1
Chaine2 = Left(.Caption, Len(Texte) - Len(.Caption) + 1)
Chaine1 = Right(.Caption, Len(.Caption) - 1) & Chaine2
.Caption = Chaine1
End With

End Sub

Private Sub UserForm_Activate()
Chrono
End Sub

Private Sub UserForm_Click()
ArretDefil = Not ArretDefil
'des clics successifs arrêtent
'ou démarrent le défilement en
'fonction de la valeur d'ArretDefil
Chrono
End Sub

Private Sub UserForm_Initialize()
Texte = "Voici un message " & _
"défilant pour animer et " & _
"attirer l'attention !" & Space(5)
With Label1
.Caption = Texte
.Font.Bold = True
End With
End Sub

Hervé.

"PTIFRED" a écrit dans le message news:
2f1201c47e3f$e97d29f0$
Bonjours
dans un userform je voudrai savoir si c'est possible de
faire defiller un texte (de gauche a droite ou inverse) de
presentation
par avance merci