使单元格 scroll/marquee 从右到左显示文本?

Make a cell scroll/marquee text right to left?

我的单元格 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

虽然这可以在子例程的 for 循环内完成,但在执行 for 循环时整个应用程序将被锁定,这将非常无益。

而是将子例程的一个 运行 视为一次迭代。当子 运行s 您希望它检测消息中字幕在单元格 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...

整个子例程将 运行 一闪而过,因此工作簿的用户真的不应该看到它每秒 运行 将选取框跳到下一个字符。