Сделать ячейку прокрутки/выделения текста справа налево?

Question

У меня есть моя ячейка M2 в Excel, которая содержит большое количество текста. Я пытаюсь найти способ сделать этот текст прокруткой справа налево непрерывно.

Я много сделал в Интернете, но все, что я могу найти, это такие коды, которые не имеют для меня никакого смысла, и я хочу попытаться сделать это максимально простым. Может кто-нибудь, пожалуйста, покажет мне простой способ заставить это делать то, что я хочу.

Sub StartMarquee() 
Dim sMarquee As String 
Dim iPosition As Integer 

sMarquee = "This is a scrolling Marquee" 

With Me 
With .tbMarquee 
.Text = "" 

For iPosition = 1 To Len(sMarquee) 
.Text = .Text & Mid(sMarquee, iPosition, 1) 
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1) 
Next iPosition 
End With 
End With 

'Beep 
'Application.OnTime Now + TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2), "StartMarquee" 
End Sub 

Answer 1

В то время как это может быть сделано внутри для цикла в подпрограмме, все приложение будет заперт в то время как цикл выполняется, что сделает его крайне бесполезным.

Вместо этого подумайте об одном прогоне подпрограммы как о единственной итерации. Когда подпрограммы вы хотите, чтобы он обнаружил, где в сообщении уже выделена область в ячейке M13, а затем нажмите сообщение еще один символ. Тогда сделка Application.OnTime будет планировать подпрограмму для следующей итерации.

Sub DoMarquee() 
    Dim sMarquee As String 
    Dim iWidth As Integer 
    Dim iPosition As Integer 
    Dim rCell As Range 
    Dim iCurPos As Integer 

    'Set the message to be displayed in this cell 
    sMarquee = "This is a scrolling Marquee." 

    'Set the cell width (how many characters you want displayed at once 
    iWidth = 10 

    'Which cell are we doing this in? 
    Set rCell = Sheet1.Range("M2") 

    'determine where we are now with the message. 
    ' instr will return the position of the first 
    ' character where the current cell value is in 
    ' the marquee message 
    iCurPos = InStr(1, sMarquee, rCell.Value) 

    'If we are position 0, then there is no message, so start over 
    ' otherwise, bump the message to the next characterusing mid 
    If iCurPos = 0 Then 
     'Start it over 
     rCell.Value = Mid(sMarquee, 1, iWidth) 
    Else 
     'bump it 
     rCell.Value = Mid(sMarquee, iCurPos + 1, iWidth) 
    End If 

    'Set excel up to run this thing again in a second or two or whatever 
    Application.OnTime Now + TimeValue("00:00:01"), "DoMarquee" 
End Sub 

Поместите это в новый модуль, в свой VBE для книги и запустите его. Если вы хотите, чтобы он остановился, прокомментируйте, что последняя строка Application.OnTime...

Вся эта подпрограмма запускается во вспышке, поэтому пользователь книги действительно не должен видеть, что она работает каждую секунду, чтобы набросить выделение на следующий символ.