VBA Read cell value character by character

Skovgaard

Board Regular
Joined
Oct 18, 2013
Messages
195
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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)
Code:
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
Code:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Test as follows

Run Sheet1.Tell_Me_A_Story
 
Last edited:
Upvote 0
I've prepared something like this:

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


Code:
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.
 
Upvote 0
instructions as for post#2 , but using 2 loops to avoid using Sleep

in SHEET module
Code:
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
 
Last edited:
Upvote 0
I've forgot to add:

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

 
Last edited:
Upvote 0
instructions as for post#2 , but using 2 loops to avoid using Sleep

in SHEET module
Code:
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
 
Upvote 0
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

Code:
[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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,188
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top