Wrox Programmer Forums
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old March 25th, 2008, 05:08 AM
Authorized User
 
Join Date: Feb 2007
Posts: 25
Thanks: 0
Thanked 0 Times in 0 Posts
Default Looping Code

The code below simply creates a marquee and scrolls text in a label with the help of a timer control. My problem at the moment is getting the text to come back and continue scrolling. At the moment it only scrolls once and does not come again like a marquee should.

Option Explicit
Dim TextForMarquee As String, Marqueemax As Integer
Dim MarqueeText As String, MarqueeLength As Integer, SPoint As Integer

Private Sub Timer1_Timer()

    'initial load causes the scroll to to start at one character
    'and add till the marqueemax is reached

    If Len(MarqueeText) < Marqueemax And Len(TextForMarquee) - SPoint > Marqueemax Then
        If SPoint = 0 Then SPoint = 1
        MarqueeText = Mid(TextForMarquee, SPoint, MarqueeLength)
        If MarqueeLength < Marqueemax Then MarqueeLength = MarqueeLength + 1
        lblMarquee.Caption = MarqueeText
    Else
        'Once the marqueemax is reached the starting point for the
        'mid function extraction is Incremented
 SPoint = SPoint + 1
        'left justify the text
                                                'lblMarquee.Alignment = 0
        lblMarquee.TextAlign = fmTextAlignLeft
        'Extract the current text to display
        MarqueeText = Mid(TextForMarquee, SPoint, Marqueemax)
        'Display extracted text
 lblMarquee.Caption = MarqueeText
        'Text reached the end so reset variables and display text
        If SPoint = Len(TextForMarquee) + 1 Then
            lblMarquee = ""
            MarqueeLength = 1

            'center justify
                                                'lblMarquee.Alignment = 2
            lblMarquee.TextAlign = fmTextAlignCenter
            lblMarquee.Left = 1200
            'MarqueeText = Mid(TextForMarquee, SPoint, MarqueeLength)
            SPoint = 0
        End If

    End If

End Sub
Private Sub UserForm_Initialize()

    'The length of the marquee in characters
    Marqueemax = 12
    'Starting number of characters displayed in the marquee
    MarqueeLength = 1
    'Starting position of the mid function
    SPoint = 1
    'store the string to be displayed in the marquee
    TextForMarquee = "This text will continue wrapping with this message"
    'store the characters actually displayed in the marquee label
    MarqueeText = Left(TextForMarquee, MarqueeLength)
    'put the text in the marquee label caption
    lblMarquee.Caption = MarqueeText

End Sub

 
Old March 25th, 2008, 09:36 AM
Authorized User
 
Join Date: Mar 2008
Posts: 35
Thanks: 0
Thanked 1 Time in 1 Post
Default

Hi takwirira,
1. I have used a textbox for the marquee because labelboxes don't show trailing spaces when right-aligned and they mess up the smooth flow of the marquee characters.
2. When text starts coming in from the right hand side, the marquee text must already have been filled with enough trailing spaces, so as not to interrupt the smooth flow at the very moment when all visible characters have scrolled in.
3. I use a button (btnScroll) to start the scroll.
4. I use another button (btnStop) to stop the scroll.
Code:
Private Sub UserForm_Activate()
Me.txtMarquee.Text = "This is a scrolling marquee"
Me.txtMarquee.TextAlign = fmTextAlignLeft
End Sub
Button to start the Scroll:
Code:
Private Sub btnScroll_Click()
Dim StartTimer As Single, EndTimer As Single, timeWait As Single
Dim MarqueeMax As Integer, MarqueeLength As Integer, i As Integer
Dim Marquee As String
timeWait = 0.08
Do
   'Marquee without trailing spaces
   Marquee = "This is a scrolling marquee"
   Me.txtMarquee.TextAlign = fmTextAlignLeft
   For i = Len(Marquee) To 1 Step -1
      Me.txtMarquee.Text = Right(Marquee, i)
      StartTimer = Timer
      Do While Timer < StartTimer + timeWait
         DoEvents
      Loop
   Next 'i
   'No time-delay here for immediate flow from the right
   Me.txtMarquee.Text = ""
   'Marquee with enough trailing spaces to fill the length of the textbox
   Marquee = "This is a scrolling marquee                         "
   Me.txtMarquee.TextAlign = fmTextAlignRight
   For i = 1 To Len(Marquee) - 1
      Me.txtMarquee.Text = Mid(Marquee, 1, i)
      StartTimer = Timer
      Do While Timer < StartTimer + timeWait
         DoEvents
      Loop
   Next 'i
   'No time-delay after the full string, for smooth re-flow
   Me.txtMarquee.Text = Mid(Marquee, 1, i)
Loop
End Sub
Button to stop the Scroll:
Code:
Private Sub btnStop_Click()
End
End Sub
 
Old March 26th, 2008, 01:19 AM
Authorized User
 
Join Date: Mar 2008
Posts: 35
Thanks: 0
Thanked 1 Time in 1 Post
Default

Actually, takwirira, you can scratch out the declarations of the variables MarqueeMax, MarqueeLength and EndTimer as they are leftovers from my first coding attempts.


 
Old March 26th, 2008, 03:59 AM
Authorized User
 
Join Date: Feb 2007
Posts: 25
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Thank you so much, I can always format the textbox to look like a label. Much appreciated !

 
Old March 26th, 2008, 04:39 AM
Authorized User
 
Join Date: Feb 2007
Posts: 25
Thanks: 0
Thanked 0 Times in 0 Posts
Default

The code has been modified to the following and works beautifully. only thing though is everytime it scrolls and finishes the first line.It pauses for a few seconds then continues again.I thought this is when its adding the spaces and I took those out but it pauses instead of continually scrolling as it should.Even if this cannot be changed Im still happy witht the result

THANKS AGAIN tstav.

Function Marquees()

        Sheets("Sales Info").Select

        Dim StartTimer As Single, timeWait As Single
        i As Integer
        Dim Marquee As String
        timeWait = 0.08

        Do
           'Marquee without trailing spaces
           Marquee = Range("b46")
           Me.txtMarquee.TextAlign = fmTextAlignLeft
           For i = Len(Marquee) To 1 Step -1
              Me.txtMarquee.Text = Right(Marquee, i)
              StartTimer = Timer
              Do While Timer < StartTimer + timeWait
                 DoEvents
              Loop
           Next 'i
           'No time-delay here for immediate flow from the right
           'Me.txtMarquee.Text = ""
           'Marquee with enough trailing spaces to fill the length of the textbox

           Me.txtMarquee.TextAlign = fmTextAlignRight
           For i = 1 To Len(Marquee) - 1
              Me.txtMarquee.Text = Mid(Marquee, 1, i)
              StartTimer = Timer
              Do While Timer < StartTimer + timeWait
                 DoEvents
              Loop
           Next 'i
           'No time-delay after the full string, for smooth re-flow
           Me.txtMarquee.Text = Mid(Marquee, 1, i)
        Loop

End Function

 
Old March 26th, 2008, 11:42 AM
Authorized User
 
Join Date: Mar 2008
Posts: 35
Thanks: 0
Thanked 1 Time in 1 Post
Default

OK, it came as a surprise to me the fact that the scroll "freezes", as you say, for a few seconds and then restarts. You see, it never froze in MY example, on MY screen.

But then I figured it out. Here it is:

As you noticed, I was asking that you add "enough trailing spaces to the marquee" so that it filled the entire length of the textbox when the scroll was to come from the right hand side. That was because I had drawn MY textbox to be WIDER than the marquee!

I bet YOUR textbox is narrower than the marquee!

So, when the marquee starts coming in from the right, it reaches the left edge and then seems to "freeze" because the extra (not visible characters) are being added but YOU JUST DON'T SEE THEM! And after this finishes, the marquee starts all over again (this time from the left) and voila the motion again!

Remedy: Stretch the textbox so that it can take the whole of the marquee (no extra blank space, though) and the problem will go away!

And let me know...

Regards, tstav

 
Old March 26th, 2008, 11:47 AM
Authorized User
 
Join Date: Mar 2008
Posts: 35
Thanks: 0
Thanked 1 Time in 1 Post
Default

As for the code I have turned it into a function (since that's what you want it to be) and I have simplified it even more.
Have a look.
Code:
Function Marquees()
Dim StartTimer As Single, timeWait As Single
Dim i As Integer
Dim Marquee As String
timeWait = 0.08
Sheets("Sales Info").Select
Marquee = Range("B46").Value
Do
   Me.txtMarquee.TextAlign = fmTextAlignLeft
   For i = Len(Marquee) To 0 Step -1
      Me.txtMarquee.Text = Right(Marquee, i)
      StartTimer = Timer
      Do While Timer < StartTimer + timeWait
         DoEvents
      Loop
   Next 'i
   Me.txtMarquee.TextAlign = fmTextAlignRight
   For i = 1 To Len(Marquee)-1
      Me.txtMarquee.Text = Mid(Marquee, 1, i)
      StartTimer = Timer
      Do While Timer < StartTimer + timeWait
         DoEvents
      Loop
   Next 'i
Loop
End Function
 
Old April 18th, 2008, 04:17 AM
Authorized User
 
Join Date: Feb 2007
Posts: 25
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Thanks tstav, this works beautifully






Similar Threads
Thread Thread Starter Forum Replies Last Post
Speed up code - looping and copy / paste vba_user Excel VBA 6 March 23rd, 2011 05:27 PM
looping code with if's chimp Excel VBA 0 June 30th, 2008 12:44 PM
Looping Code 2 takwirira Excel VBA 0 May 19th, 2008 06:39 AM
Looping..? dedex C# 2 January 6th, 2005 11:24 PM
How to speed up looping ADO code? llowwelll Pro VB Databases 7 October 24th, 2004 11:12 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.