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循环中完成，但是当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...

整个子程序将在闪存中运行，因此工作簿的用户实际上不应该看到它每秒运行以将选取框撞到下一个字符。

从右到左制作单元格滚动/字幕文本？

1 个答案: