VBA Read cell value character by character

[Skovgaard]

Hi All,

I hope you can help.
I've found below thread, and have a similar challenge.

https://www.mrexcel.com/forum/excel-questions/590962-typewriter-animated-text-excel.html

Instead of writing the text in the VBA code, I would like to pick up the text from another cell in the workbook. It should then be displayed in a textbox/msgbox etc. When the whole sentence from the cell is picked up, you should then be able to close the box.
Basically I would like to "tell a story" in Excel, animated like using a typewriter.

Is this possible?

/Skovgaard

 

[Yongle]

Test in a NEW workbook

In Sheet1

- in cell A1 enter your "story" text
- using Developer Tab \ Inset \ Active_x textbox (should be TextBox1)

VBA

In SHEET module (right click on sheet tab \ View Code \ paste VBA into code window)

Sub Tell_Me_A_Story()
    Dim T As String, x As Long
    T = Range("A1").Value
    For x = 1 To Len(T)
        TextBox1.Value = Left(T, x)
        Sleep 200
        DoEvents
    Next
End Sub

IN STANDARD module

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Test as follows

Run Sheet1.Tell_Me_A_Story

 

[KOKOSEK]

I've prepared something like this:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub TellMeStory()
    Dim LineLen As Long
    Dim LineText As String
    Dim cell As Range
    Dim i, j As Long
    Sheets(1).Shapes("display").Visible = True


    j = Range("T1").Value 'reading what is next line
    LineText = Range("A" & j).Value
    LineLen = Len(LineText)
    For i = 1 To LineLen
            Sheets(1).Shapes("display").TextFrame.Characters.Text = Mid(LineText, 1, i)
            DoEvents
            DoEvents
            DoEvents
            DoEvents
            DoEvents
            Sleep 100
            
    Next i
End Sub


Sub hideMe()
    Sheets(1).Shapes("display").Visible = False
    Range("T1").Value = Range("T1").Value + 1 'goto next line
    Call TellMeStory
End Sub

create TextBox and change its name into 'display'.


I can't find out how to attached file.

 

[Yongle]

instructions as for post#2 , but using 2 loops to avoid using Sleep

in SHEET module

Sub Tell_Me_A_Story2()
    Dim T As String, x As Long, a As Long
    T = Range("A1").Value
    For x = 1 To Len(T)
        For a = 1 To 200
            TextBox1.Value = Left(T, x)
            DoEvents
        Next a
    Next x
End Sub

 

[KOKOSEK]

I've forgot to add:

create TextBox and change its name into 'display' and assign macro hideMe

 

[Skovgaard]

Thanks a lot, this worked perfect as I wanted it

 

[Skovgaard]

instructions as for post#2 , but using 2 loops to avoid using Sleep

in SHEET module

Sub Tell_Me_A_Story2()
    Dim T As String, x As Long, a As Long
    T = Range("A1").Value
    For x = 1 To Len(T)
        For a = 1 To 200
            TextBox1.Value = Left(T, x)
            DoEvents
        Next a
    Next x
End Sub

I have an additional question.
What if I want to force a line break, is that possible?

I've tried to do it directly in the cell. It seems to work, but line two is running real slow, and not with same speed as line one.
Or should a new line come from another cell?

/Skovgaard

 

[Yongle]

I also get a delay when using the 2 loops.

Try this instead
- works for me

1. Change textbox MultiLine property to TRUE
2. In cell A1 create each line break with {ALT){ENTER}

In SHEET module

[COLOR=#006400][I]'at top[/I][/COLOR]
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Tell_Me_A_Story()
    Dim t As String, x As Long
[I][COLOR=#006400]'clear previous value[/COLOR][/I]
    TextBox1.Value = vbNullString
    Sleep 50
    DoEvents
[COLOR=#006400][I]'display like a typewriter[/I][/COLOR]
    t = Range("A1").Value
    For x = 1 To Len(t)
        TextBox1.Value = Left(t, x)
        Sleep 100
        DoEvents
    Next
End Sub

 

[Skovgaard]

Thanks Yongle, works perfect!