Texte defilant

Bonjour a tous et toutes, forum bonjour,

Ce code est senser faire défiler le texte dans A1pendant quelques secondes puis une tempo de 3 secondes et c'est le texte de A2 qui défile.

Et bien ca défile mais constater par vous mème l'affichage c'est pas ca.

(1) souci le texte passe en rouge gras, c'est pas le but

(2) souci quand le texte s'arrète hé c'est pas terrible non plus

Si quelqu'un veut bien SVP se pencher dessus et me donner un petit coup de main, ca serai super sympa.

En tout cas merci a vous et de votre temps et bonne journée malgré la pluie

Raymond

Option Explicit
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Sub Tst()
Dim X, y As Byte
[A1] = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
[A2] = "Semaine: " & DatePart("ww", Date, vbMonday) & "     " & _
     DatePart("y", Date, vbMonday) & " ième jour de l" & Chr(180) & "année"

With [A1:A2].Characters(1).Font
.FontStyle = "Gras"
.ColorIndex = 3
End With

With [A1:A2].Characters(2).Font
.FontStyle = "Normal"
.ColorIndex = xlAutomatic
End With

X = InStr(InStr([A1], " ") + 2, [A1], " ")        'Détecte 2 espaces dans la date

With [A1].Characters(X + 1).Font                  'Pour deuxième majuscule Mois
.FontStyle = "Gras"
.ColorIndex = 3
End With

With [A1].Characters(X + 2).Font
.FontStyle = "Normal"
.ColorIndex = xlAutomatic
End With

End  'Mis END pour essai majuscule sans déclencher a chaque fois le défilement

'*** CODE POUR LE DEFILEMENT DES DEUX MESSAGES CELLULES A1/A2
Dim C As Range: Dim D As Range: Dim i
Set C = [A1]
For i = 1 To 40                                   'Durée de rotation de la date
C = Right(C, Len(C.Value) - 1) + Left(C, 1)
Sleep 220                                         'Vitesse de rotation
Next i
Application.Wait (Now + TimeValue("00:00:03"))    'Tempo de 3 secondes
Set D = [A2]
For i = 1 To 40                                   'Durée de rotation semaine et jour
D = Right(D, Len(D.Value) - 1) + Left(D, 1)
Sleep 220                                         'Vitesse de rotation
Next i
End Sub

Bonjour

un petit essai

edit: Voir fichier dans les messages suivants

cordialement

Bonjour maguetlolo, bonjour forum,

Merci pour le petit code, ca marche " presque " juste une question pourquoi le texte ne défile pas normalement tel qu'il a été créer, c'est a dire avec les majuscules rouges et gras et font noir après la majuscule.

Pour le (J)our et le (M)ois ainsi que (S)emaine et pourquoi ca passe rouge gras quand le défilement commence.

Par contre a l'arrèt du défilement ca se repositionne correctement.

A part que le code fait un peu usine a gaz, il ni a pas moyen de faire mieux en VBA.

Voila en tout cas merci pour temps passer dessus

Je te souhaite une bonne journée, dit moi si il y aurai une autre possibilité SVP

Raymond

Bonjour le forum

voici le final,

Pour le défilement en rouge, je pense que ca vient des majuscules en rouge. et je ne saurai pas corriger cela. je te le fait juste défiler en noir.

https://www.excel-pratique.com/~files/doc2/rt46cdefilement.xls

cordialement

Salut maguetlolo, forum,

Merci Merci Merci beaucoup, ca me va bien comme ca et ca marche.

Si tu as le temps et sans vouloir abuser, je souhaiterai mettre aussi le (J) de jour en rouge et gras.

Voila en tout cas merci a toi passe une excellente après midi.

Une question svp: Tu sais pourquoi on peut pas faire défiler avec les majuscules en couleurs.

Bye Bye Raymond

re

Voici ton fichier avec le j de jour en rouge

pour le defilement, je ne saurais te répondre, peut-etre que cela est possible mais ca depasse mes compétences.

https://www.excel-pratique.com/~files/doc2/YA0JLdefilement.xls

Cordialement

Re maguetlolo, forum

Re merci a toi c'est super sympa, tout fonctionne bien, je vais intégrer le code a mon programme cette apres midi

Par contre pour le bouton qui appelle la macro comment on a accès a celui ci, car je voudrai le rennomer et le deplacer svp

J'essairai de me renseigner pour la question que je t'ai poser, je te dirai si je trouve, c'est la moindre des choses.

Encore merci et bonne après midi a toi.

Raymond

Salut maguetlolo, forum

Encore un gros merci a toi, c'est bon pour le bouton j'ai trouver. tout marche bien.

je vais en quète de savoir pourquoi les majuscules en rouge ne défilent pas, apres avoir regarder le code, sans etre balèze, si je trouve, on pourrai peut etre bien rapetisser le code, ca reste a voir.

Bonne apres midi

Raymond

Salut le forum

Raymond(Duduleray), tu as la même solution de l'autre côté

Option Explicit
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Sub Tst()

Dim I As Byte
Dim C As Range

[A1] = Application.Proper(Format(Date, "dddd dd mmmm yyyy")) & " "
Maj_Rouge ([A1])

[A2] = "La " & DatePart("y", Date, vbMonday) & " ième Journée" & _
   " de la " & DatePart("ww", Date, vbMonday) & " ième Semaine. "
Maj_Rouge ([A2])

'*** Code pour le défilement du texte des cellules A1 et A2 ***

Sleep 1000

Set C = [A1]
For I = 1 To Len([A1]) * 2
C = Right(C, Len(C.Value) - 1) + Left(C, 1)
Maj_Rouge ([A1])
Sleep 100
Next I

Sleep 1000

Set C = [A2]
For I = 1 To Len([A2]) * 2
C = Right(C, Len(C.Value) - 1) + Left(C, 1)
Maj_Rouge ([A2])
Sleep 100
Next I

Set C = Nothing

End Sub

Sub Maj_Rouge(Cellule As Range)
Dim I As Byte
For I = 1 To Len(Cellule)
With Cellule
  With .Characters(I).Font
    .FontStyle = "Normal"
    .ColorIndex = xlAutomatic
  End With
    Select Case Asc(Mid(.Value, I, 1))
        Case 65 To 90
            With .Characters(I).Font
                .FontStyle = "Gras"
                .ColorIndex = 3
            End With
    End Select
  With .Characters(I + 1).Font
    .FontStyle = "Normal"
    .ColorIndex = xlAutomatic
  End With
End With
Next I
End Sub

En espérant que la limite de la simplification est atteinte

Désolé, d'avoir envahi cette ficelle

Mytå

P.S. Il faut le dire que l'on demande la même chose sur d'autres forum