Scrolling Text

[neo2]

Is it possible to get scrolling text like a marquee effect in excel ?

 

[gauntletxg]

Something like this might be what you are looking for

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub CommandButton1_Click()
Dim i As Long, txt As String, rng As Range
Set rng = Range("A1")
txt = "HELLO WORLD"

For i = 1 To Len(txt)
    rng.Value = Left(txt, i)
    Sleep 50
Next
End Sub

 

[neo2]

this does not do what I'm looking for. I want the text to move across the cell, like what you see on the stock tickers on tv.

 

[Jaafar Tribak]

Just bumping this thread to see if somoeone knows of an easy way of doing this . Unless I am missing something, achieving this scrolling effect (stock tickers) is not as easy as it first appears.

I have a workaround in mind but it is rather involved . Maybe I am missing an easier solution..

 

[Michael M]

Hey Jaafar & Neo2
I've used this in the past.
It will need editing and I don't remember who to give credit to.

Sub Macro1()
Dim sTxt As String
Dim yTxt As String
Dim x As Integer, y As Integer
Dim Start, Delay
Dim myCell, myCell2
Dim Indexer As Single
Dim blnRight As Boolean

On Error Resume Next

Set myCell = Range("B2")
Set myCell2 = Range("D3")
Indexer = 50
Application.DisplayStatusBar = True
Application.StatusBar = "... Select Cell to Stop and Edit " & _
   "or Wait for Flashing to Stop! "
 
sTxt = "Michael is in the office : " & Format$(Now, "d mmmm yyyy") & "!!!!!!!!"
yTxt = "Doing everybody else's work"

Do While Range("A1").Value <> ""
   DoEvents
   For y = 1 To 2                                  'Indexer Loops through the scrolling
      For x = 1 To Indexer                         'Index number of times
         Start = Timer                             'Set start to internal timer
         Delay = Start + 0.02                      'Set delay for .15 secs
         Do While Timer < Delay                    'Do the display routine
            If blnRight Then                       'have u reached the right hand side
               [D2] = Space(Indexer - x) & sTxt
               [D3] = Space(x) & yTxt              'Show 1 str @ a time
            Else
               [D2] = Space(x) & sTxt
               [D3] = Space(Indexer - x) & yTxt    'Show 1 str @ a time
            End If
            DoEvents
         Loop                                       'Loop until delay is up
      Start = Timer                                 'and reset the timer
      Delay = Start + 0.02                          'and the delay
      If x = Indexer Then blnRight = Not (blnRight) 'True or false
   Next x                                           'Show the next str
Next y
Loop                                                'Do this again
[D2] = ""                                           'Reset
[D3] = ""

 
JACK:
Application.StatusBar = False
Application.DisplayStatusBar = Application.DisplayStatusBar
 
End Sub

 

[Jaafar Tribak]

Thanks Michael.

I am familiar with similar algorithms but one of the main problems with this is that the text overlaps adjacent cells and It is difficult to figure out the exact position of the last Character based on the Cell width.

In order to achieve the Stock Tickers effect, the characters need to disappear one by one when reaching the width of the cell as they are being pushed

 

[jasonb75]

An crude, ugly and slow scrolling method, but it cures the overlap problem.

A1 holds original text, A2 holds this formula to produce the marquee effect, combined with an event timer to force excel recalc at 1 sec intervals.

=MID(A1&REPT(" ",CELL("Width",A2)),MIN(1,MOD(SECOND(NOW()),(LEN(A1&REPT(" ",CELL("Width",A2)))))),CELL("Width",A2))

Maybe combining this theory with Michaels code will provide an ideal solution.

 

[Jaafar Tribak]

Thanks jasonb75. Nice use of the Cell("Width",...) Function ! - It does almost cure the overlap problem.

Close but not exactly the desired visual effect. I have played with your formula based solution and combined it with Michael's code and other similar codes but none of them yield the desired result.

I am just putting the last touches on the code I have written which is as close as I could get . I'll post it shortly.

 

[jasonb75]

Had another look at this, not thought of using Timer and DoEvents until I had a closer look at Michaels code.

In a standard module

Sub Ticker()
Application.Calculation = xlCalculationManual
Dim tMsg As String, tCell As Range, tLen As Long, tPos As Long
Dim Start, Delay
    Set tCell = Range("A1")
    tMsg = "This is a test message!"
With tCell.Font
        .Name = "Courier New"
        .FontStyle = "Regular"
        .Size = 10
End With
    tCell.ColumnWidth = Round(tCell.ColumnWidth, 0)
    tLen = tCell.ColumnWidth - 1
Do
    Start = Timer
If tPos > Len(tMsg) Then
    tPos = 1
Delay = Timer + 1
Else
    tPos = tPos + 1
Delay = Timer + 0.2
End If
    Do While Timer < Delay
        DoEvents
        tCell.Value = Mid(tMsg, tPos, tLen)
    Loop
Loop
End Sub

Assuming DoEvents kills the code instantly when interupted I've used a change event in the worksheet module where the ticker is located to re-enable calculation.

Sub worksheet_change(ByVal target As Range)
Application.Calculation = xlCalculationAutomatic
End Sub

Finally in the workbook module to kick off when the file is opened, short and simple

Private Sub Workbook_Open()
Ticker
End Sub

The only thing I'm unsure of now is restarting the ticker after it's been interupted, given the way code is executed in excel I don't think a continuous scroll effect is possible without using a formula / force recalc method, which I thought after suggesting before, could, if the workbook is formula heavy, be asking for disaster.

 

[Jaafar Tribak]

Thanks Jasonb75 for your help with this.

Unfortunatly having a constant recalculation like you said is not a practical solution. Also, the visual effect is still not the Stock Ticker one.