OVH Cloud OVH Cloud

Srolling dans une cellule !

7 réponses
Avatar
Eric
Bonsoir,

Une macro pour le FUN, un défit pour les passionnés :)

Y aurait il un moyen de faire scroller du texte (en mode graphique) dans une
ou plusieurs cellules ?

Ca ferait fun dans un beau tableau.

Eric, pour le fun ;-)

7 réponses

Avatar
Daniel.M
Salut Éric,

Sub scrollYa()
Dim i%, j%, s$
s = " Allons enfant de la patrie, le jour de gloire est arrivé "

j = Len(s)
For i = 1 To j * 4 ' pour tourner 4 fois!
[A1] = Mid(s, 1 + (i Mod j), j) & Mid(s, 1, (i Mod j))
Next i
End Sub

Salutations,

Daniel M.

"Eric" wrote in message
news:%
Bonsoir,

Une macro pour le FUN, un défit pour les passionnés :)

Y aurait il un moyen de faire scroller du texte (en mode graphique) dans
une

ou plusieurs cellules ?

Ca ferait fun dans un beau tableau.

Eric, pour le fun ;-)




Avatar
Jean-François Aubert
Bonsoir Daniel,
Très joli, mais un peu rapide pour les Suisses.
Alors, à la sauce vaudoise, ça fait un truc comme ça :

Sub scrollYa()

Dim i%, j%, s$
Dim ralentir
x = Timer
s = " De bleu, de bleu, Daniel, pas si vite, y a pas le feu au lac ! "
j = Len(s)
For i = 1 To j * 4 ' pour tourner 4 fois!
For ralentir = 1 To 500000
Next
[A1] = Mid(s, 1 + (i Mod j), j) & Mid(s, 1, (i Mod j))
For ralentir = 1 To 500000
Next
Next i
y = Timer
MsgBox y - x
End Sub

--
Amicalement

Jean-François Aubert
{Vaudois de la Côte Lémanique}


"Daniel.M" a écrit dans le message de
news:%
Salut Éric,

Sub scrollYa()
Dim i%, j%, s$
s = " Allons enfant de la patrie, le jour de gloire est arrivé "

j = Len(s)
For i = 1 To j * 4 ' pour tourner 4 fois!
[A1] = Mid(s, 1 + (i Mod j), j) & Mid(s, 1, (i Mod j))
Next i
End Sub

Salutations,

Daniel M.

"Eric" wrote in message
news:%
Bonsoir,

Une macro pour le FUN, un défit pour les passionnés :)

Y aurait il un moyen de faire scroller du texte (en mode graphique) dans
une

ou plusieurs cellules ?

Ca ferait fun dans un beau tableau.

Eric, pour le fun ;-)







Avatar
AV
La même chantée par JPS à la fin du repas des anciens combattants d'AFN !

Sub scrollYb()
Dim i%, j%, s$
s = "Allons enfants de la patrie, le jour de gloire est arrivé "

j = Len(s)
For i = 1 To j
For Each c In [A1:IV500]
Next
[A1].Font.Size = 20
[A1] = Mid(s, 1 + (i Mod j), j) & Mid(s, 1, (i Mod j))
For Each c In [A1:IV500]
Next
[A1].Font.Size = 30
Next i
[A1] = "Hips !"
End Sub

;-)
AV
Avatar
Daniel.M
L'effet est stupéfiant ;-)

Daniel M.
Avatar
AV
C'est un jeu ??

Sub scroll_zzz()
txt1 = " Allons enfants de la patrie"
txt2 = " Le jour de gloire est arrivé !"
txt3 = " Contre nous de la tyrannie"
txt4 = " L'étendard sanglant est levé"
For i = 1 To 100
[A1] = Mid(txt1, 1 + (i Mod 33), 33) & Mid(txt1, 1, (i Mod 33))
For Each c In [A1:IV100]: Next
[A2] = Mid(txt2, 1 + (i Mod 33), 33) & Mid(txt2, 1, (i Mod 33))
For Each c In [A1:IV100]: Next
[A3] = Mid(txt3, 1 + (i Mod 33), 33) & Mid(txt3, 1, (i Mod 33))
For Each c In [A1:IV100]: Next
[A4] = Mid(txt4, 1 + (i Mod 33), 33) & Mid(txt4, 1, (i Mod 33))
For Each c In [A1:IV100]: Next
Next i
End Sub

AV

"Eric" a écrit dans le message news:

Bonjour,

Génial, le defit est relevé !
Poussont le bouchon un peut plus loin, si vous ête d'accord bien sur, ça ne
sert à rien, c'est juste pour le fun :)

Alors voyons l'effet desiré est le suivant : pouvoir faire scrollé en même
temps le contenue de plusieurs cellules, mettons trois... de façon
continues... on peut programmer sous interruption en VBA ? every time??

Cordialement

Eric

"Daniel.M" a écrit dans le message de news:
#

L'effet est stupéfiant ;-)

Daniel M.







Avatar
Modeste
;-)))
pffff....
le bouchon ? tout au plus une capsule !!!
et le every time ????

bon j'aime pas trop les fonctions onTime mais
on peut tenter un truc comme ça :

it's not perfect...
prévoir un bouton (macro ScrollOff) pour arreter le
bouzin !!!!

'-------------------
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As
Long)
'-----------------------
Public NewTime As Date
'======================== ========================= =========
Sub ScrollOn()
NewTime = Now + TimeValue("00:01:00")
Application.OnTime NewTime, "scrollGd"
End Sub
'======================== ========================= =========
Sub ScrollGD()
Application.EnableCancelKey = xlErrorHandler
On Error GoTo fini:
Dim laplage As Range, Ptn As Range
Dim i%, j%, s$
s = "Le Défilement sera relancé dans une minute !!! Echap
maintenant pour arreter !!!!"
j = Len(s)
'plage variable----
Set laplage = Range(ActiveSheet.Cells(1 + Rnd() * 20, 1 +
Rnd() * 10).Address)
For i = 1 To 4 ' pour 1+ 4 occurences
Randomize (Timer)
Set Ptn = Range(ActiveSheet.Cells(1 + Rnd() * 20, 1 +
Rnd() * 10).Address)
Set laplage = Application.Union(laplage, Ptn)
Next
'-plage fixe -----------------
' Set laplage = Application.Union([A5], [B3], [C7], [D2],
[G6])
'-----------------------------
For i = 1 To j * 2
laplage = Mid(s, 1 + (i Mod j), j) & Mid(s, 1, (i Mod
j))
laplage.Font.ColorIndex = 3 + Rnd() * 5
Sleep (100)
Next i
ScrollOn
Application.StatusBar = "prochain départ " & NewTime
laplage = ""
laplage.Font.ColorIndex = xlNone
Exit Sub
fini:
ScrollOff
End Sub
'======================== =============
Sub ScrollOff()
Application.OnTime NewTime, "ScrollGD", schedule:úlse
End Sub
'======================== =============
-----Message d'origine-----
C'est un jeu ??

Sub scroll_zzz()
txt1 = " Allons enfants de la patrie"
txt2 = " Le jour de gloire est arrivé !"
txt3 = " Contre nous de la tyrannie"
txt4 = " L'étendard sanglant est levé"
For i = 1 To 100
[A1] = Mid(txt1, 1 + (i Mod 33), 33) & Mid(txt1, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
[A2] = Mid(txt2, 1 + (i Mod 33), 33) & Mid(txt2, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
[A3] = Mid(txt3, 1 + (i Mod 33), 33) & Mid(txt3, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
[A4] = Mid(txt4, 1 + (i Mod 33), 33) & Mid(txt4, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
Next i
End Sub

AV

"Eric" a écrit dans le
message news:


Bonjour,

Génial, le defit est relevé !
Poussont le bouchon un peut plus loin, si vous ête
d'accord bien sur, ça ne


sert à rien, c'est juste pour le fun :)

Alors voyons l'effet desiré est le suivant : pouvoir
faire scrollé en même


temps le contenue de plusieurs cellules, mettons
trois... de façon


continues... on peut programmer sous interruption en
VBA ? every time??



Cordialement

Eric

"Daniel.M" a écrit dans le
message de news:


#

L'effet est stupéfiant ;-)

Daniel M.







.





Avatar
Modeste
Re-Bonjour,
Pixels par pixels ???
notre ami à certainement quelque chose dans le genre
;-)))
fouiller sur http://jacxl.free.fr
@+


@+>-----Message d'origine-----
Hello :)

Oui, c'est un jeu si l'on veut :) ça ne sert à rien si ce
n'est à faire

fonctionner les méninges :) et qui sait, peut être allons
nous trouver un

passionné fou capable de faire du scrolling pixels par
pixels dans chaques

cellules individuellement et tout ceci geré sous
interruption !!

Je pense pouvoir qualifié ceci de : passion :)
Vous êtes tous trés bon.
Comme je l'ai deja dit " ce forum est une merveille !
Merci à tous ceux qui

le font vivre.."

Eric

"Modeste" a écrit dans le message de
news:

091f01c34ab4$33bd7990$
;-)))
pffff....
le bouchon ? tout au plus une capsule !!!
et le every time ????

bon j'aime pas trop les fonctions onTime mais
on peut tenter un truc comme ça :

it's not perfect...
prévoir un bouton (macro ScrollOff) pour arreter le
bouzin !!!!

'-------------------
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As
Long)
'-----------------------
Public NewTime As Date
'======================== ========================= ========
=

Sub ScrollOn()
NewTime = Now + TimeValue("00:01:00")
Application.OnTime NewTime, "scrollGd"
End Sub
'======================== ========================= ========
=

Sub ScrollGD()
Application.EnableCancelKey = xlErrorHandler
On Error GoTo fini:
Dim laplage As Range, Ptn As Range
Dim i%, j%, s$
s = "Le Défilement sera relancé dans une minute !!! Echap
maintenant pour arreter !!!!"
j = Len(s)
'plage variable----
Set laplage = Range(ActiveSheet.Cells(1 + Rnd() * 20, 1 +
Rnd() * 10).Address)
For i = 1 To 4 ' pour 1+ 4 occurences
Randomize (Timer)
Set Ptn = Range(ActiveSheet.Cells(1 + Rnd() * 20, 1 +
Rnd() * 10).Address)
Set laplage = Application.Union(laplage, Ptn)
Next
'-plage fixe -----------------
' Set laplage = Application.Union([A5], [B3], [C7], [D2],
[G6])
'-----------------------------
For i = 1 To j * 2
laplage = Mid(s, 1 + (i Mod j), j) & Mid(s, 1, (i Mod
j))
laplage.Font.ColorIndex = 3 + Rnd() * 5
Sleep (100)
Next i
ScrollOn
Application.StatusBar = "prochain départ " & NewTime
laplage = ""
laplage.Font.ColorIndex = xlNone
Exit Sub
fini:
ScrollOff
End Sub
'======================== =============
Sub ScrollOff()
Application.OnTime NewTime, "ScrollGD", schedule:úlse
End Sub
'======================== =============
-----Message d'origine-----
C'est un jeu ??

Sub scroll_zzz()
txt1 = " Allons enfants de la patrie"
txt2 = " Le jour de gloire est arrivé !"
txt3 = " Contre nous de la tyrannie"
txt4 = " L'étendard sanglant est levé"
For i = 1 To 100
[A1] = Mid(txt1, 1 + (i Mod 33), 33) & Mid(txt1, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
[A2] = Mid(txt2, 1 + (i Mod 33), 33) & Mid(txt2, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
[A3] = Mid(txt3, 1 + (i Mod 33), 33) & Mid(txt3, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
[A4] = Mid(txt4, 1 + (i Mod 33), 33) & Mid(txt4, 1,
(i Mod 33))

For Each c In [A1:IV100]: Next
Next i
End Sub

AV

"Eric" a écrit dans le
message news:


Bonjour,

Génial, le defit est relevé !
Poussont le bouchon un peut plus loin, si vous ête
d'accord bien sur, ça ne


sert à rien, c'est juste pour le fun :)

Alors voyons l'effet desiré est le suivant : pouvoir
faire scrollé en même


temps le contenue de plusieurs cellules, mettons
trois... de façon


continues... on peut programmer sous interruption en
VBA ? every time??



Cordialement

Eric

"Daniel.M" a écrit dans le
message de news:


#

L'effet est stupéfiant ;-)

Daniel M.







.




.