从右向左进行单元格滚动/选取框文本？

Question

我在Excel中包含大量文本的单元格M2。我试图找出使这个文本从右向左连续滚动的方法。

我在网上查了很多东西，但是我可以找到的是这样的代码，这对我没有任何意义，我想尽量让这个代码尽可能简单。有人能告诉我一个简单的方法让我做我想做的事。

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

虽然这可能的内部在子程序完成for循环，整个应用程序会同时进行循环执行，这将使它非常无益被关起来。

而是将一次子程序作为单次迭代运行。当子运行时，您希望它检测邮件中的哪个字幕已位于单元格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...

这个整个子程序将在闪存中运行，所以工作簿的用户确实不应该看到它每秒运行一次，以将选取框碰到下一个字符。