Make the text in a textbox scrolling horizontally in a form (1 Viewer)

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
Hi Guys

Just want to try something new in Access , to scroll the text horizontally in a form. It could be project name on the home page or any information in a textbox that keeps on moving across the form.

Can this be done?

Any help would be much appreciated.

Thanks
 

CJ_London

Super Moderator
Staff member
Local time
Today, 18:58
Joined
Feb 19, 2013
Messages
16,607
do you mean like a marquee banner with text continually scrolling right to left? Or do you mean for a user to be able to scroll a text box horizontally with a scrollbar?
 

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
do you mean like a marquee banner with text continually scrolling right to left? Or do you mean for a user to be able to scroll a text box horizontally with a scrollbar?

Yes I want this on the home page. How can this be done? Thanks
 

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
Ridders, its not working foe me. Text is not scrolling on the page . I have written the following code on Homepage:
Code:
 ResetDisplay

    MinimizeNavigationPane
    
    'Sets the timer in motion for case 10 - scrolling text

    N = 10

    
        Me.TimerInterval = 100
        Me.lblflash.Visible = True

Code:
Private Sub ResetDisplay()

    MinimizeNavigationPane
    Me.lblflash.Visible = False
    Me.lblflash.Visible = False
    Me.TimerInterval = 0
    
    'Me.cmd10.Caption = "Scrolling Marquee Text"
    'Me.cmd10.ForeColor = RGB(63, 63, 63)
   ' Me.cmd10.FontWeight = 400
    'Me.cmd10.FontSize = 12
    
End Sub

I have created following module "mNavPaneTaskbar" as you discussed in the forum:
Code:
Option Compare Database

Option Explicit
 
Dim handleW1 As Long
 
'###############################################
#If VBA7 Then 'add PtrSafe
    Private Declare PtrSafe Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
         
    Private Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal handleW1 As Long, _
        ByVal handleW1InsertWhere As Long, ByVal w As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal z As Long, _
        ByVal wFlags As Long) As Long
#ElseIf Win64 Then 'need datatype LongPtr
    Private Declare PtrSafe Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
         
    Private Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal handleW1 As LongPtr, _
        ByVal handleW1InsertWhere As LongPtr, ByVal w As LongPtr, _
        ByVal X As LongPtr, ByVal Y As LongPtr, ByVal z As LongPtr, _
        ByVal wFlags As LongPtr) As LongPtr
#Else '32-bit Office
    Private Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
         
    Private Declare Function SetWindowPos Lib "user32" _
        (ByVal handleW1 As Long, _
        ByVal handleW1InsertWhere As Long, ByVal w As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal z As Long, _
        ByVal wFlags As Long) As Long
#End If
'###############################################
 
Const TOGGLE_HIDEWINDOW = &H80
Const TOGGLE_UNHIDEWINDOW = &H40

Function HideTaskbar()
    handleW1 = FindWindowA("Shell_traywnd", "")
    Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_HIDEWINDOW)
End Function
 
Function ShowTaskbar()
    Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_UNHIDEWINDOW)
End Function

Public Function ShowNavigationPane()

On Error GoTo ErrHandler

  '  DoCmd.OpenForm "frmSettings", acDesign
    DoCmd.SelectObject acForm, , True
    
Exit_ErrHandler:
    Exit Function
    
ErrHandler:
    MsgBox "Error " & Err.Number & " in ShowNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_ErrHandler

End Function
Public Function HideNavigationPane()

'CR modified v5263

On Error GoTo ErrHandler

    DoCmd.NavigateTo "acNavigationCategoryObjectType"
    DoCmd.RunCommand acCmdWindowHide
        
Exit_ErrHandler:
    Exit Function
    
ErrHandler:
    MsgBox "Error " & Err.Number & " in HideNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_ErrHandler

End Function

Public Function MinimizeNavigationPane()

On Error GoTo ErrHandler

    DoCmd.NavigateTo "acNavigationCategoryObjectType"
    DoCmd.Minimize
        
Exit_ErrHandler:
    Exit Function
    
ErrHandler:
    MsgBox "Error " & Err.Number & " in HideNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_ErrHandler

End Function
 

isladogs

MVP / VIP
Local time
Today, 18:58
Joined
Jan 14, 2017
Messages
18,216
idders, its not working foe me. Text is not scrolling on the page . I have written the following code on Homepage:

That's because you are using the wrong code from my example
lblFlash was for the flashing text example in cmd5 button - remove it

You need a textbox called txtMarquee and the code from cmd10_Click event.

Somehow you've used bits of code from different events

Suggest you read the example to make sure you understand how it works rather than copying code and hoping for the best

NOTE:
You can ignore any code that references other parts of the example
e..g N=10
If you want the text to scroll automatically without clicking a button, use the code in the Form_Load event instead
You only need reset display if you want to be able to stop the marquee text scrolling again by clicking a button
 
Last edited:

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
Hi Ridders, I have tried the same code. Infact I have put a button named cmd10 , a textbox named txtMarquee and a label names lblflash but the text is not scrolling on the form.Please see below the code I have put on the HomePage:

Code:
Private Sub cmd10_Click()

    ResetDisplay

    MinimizeNavigationPane
    
    'Sets the timer in motion for case 10 - scrolling text

    N = 10

    If Me.TimerInterval = 0 Then
        Me.cmd10.Caption = "STOP Scrolling Marquee Text"
        Me.cmd10.ForeColor = vbRed
        Me.cmd10.FontWeight = 800
        Me.cmd10.FontSize = 16
        Me.TimerInterval = 100
        Me.txtMarquee.Visible = True
        strText = "      IMPORTANT MESSAGE : This database will shortly be closing for essential maintenance work." & _
            " Please save your current task and close the program. Apologies for any inconvenience . . . "

    Else
        Me.TimerInterval = 0
        Me.txtMarquee.Visible = False
        Me.cmd10.Caption = "Scrolling Marquee Text"
        Me.cmd10.ForeColor = RGB(63, 63, 63)
        Me.cmd10.FontWeight = 400
        Me.cmd10.FontSize = 12
        strText = ""
    End If

End Sub

Code:
Private Sub ResetDisplay()

    MinimizeNavigationPane
    Me.lblFlash.Visible = False
    Me.txtMarquee.Visible = False
    Me.TimerInterval = 0
    
    Me.cmd10.Caption = "Scrolling Marquee Text"
    Me.cmd10.ForeColor = RGB(63, 63, 63)
    Me.cmd10.FontWeight = 400
    Me.cmd10.FontSize = 12
    
End Sub

The following Module mNavPaneTaskbar is present in the project as well:
Code:
Option Compare Database

Option Explicit
 
Dim handleW1 As Long
 
'###############################################
#If VBA7 Then 'add PtrSafe
    Private Declare PtrSafe Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
         
    Private Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal handleW1 As Long, _
        ByVal handleW1InsertWhere As Long, ByVal w As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal z As Long, _
        ByVal wFlags As Long) As Long
#ElseIf Win64 Then 'need datatype LongPtr
    Private Declare PtrSafe Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
         
    Private Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal handleW1 As LongPtr, _
        ByVal handleW1InsertWhere As LongPtr, ByVal w As LongPtr, _
        ByVal X As LongPtr, ByVal Y As LongPtr, ByVal z As LongPtr, _
        ByVal wFlags As LongPtr) As LongPtr
#Else '32-bit Office
    Private Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
         
    Private Declare Function SetWindowPos Lib "user32" _
        (ByVal handleW1 As Long, _
        ByVal handleW1InsertWhere As Long, ByVal w As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal z As Long, _
        ByVal wFlags As Long) As Long
#End If
'###############################################
 
Const TOGGLE_HIDEWINDOW = &H80
Const TOGGLE_UNHIDEWINDOW = &H40

Function HideTaskbar()
    handleW1 = FindWindowA("Shell_traywnd", "")
    Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_HIDEWINDOW)
End Function
 
Function ShowTaskbar()
    Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_UNHIDEWINDOW)
End Function

Public Function ShowNavigationPane()

On Error GoTo ErrHandler

  '  DoCmd.OpenForm "frmSettings", acDesign
    DoCmd.SelectObject acForm, , True
    
Exit_ErrHandler:
    Exit Function
    
ErrHandler:
    MsgBox "Error " & Err.Number & " in ShowNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_ErrHandler

End Function
Public Function HideNavigationPane()

'CR modified v5263

On Error GoTo ErrHandler

    DoCmd.NavigateTo "acNavigationCategoryObjectType"
    DoCmd.RunCommand acCmdWindowHide
        
Exit_ErrHandler:
    Exit Function
    
ErrHandler:
    MsgBox "Error " & Err.Number & " in HideNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_ErrHandler

End Function

Public Function MinimizeNavigationPane()

On Error GoTo ErrHandler

    DoCmd.NavigateTo "acNavigationCategoryObjectType"
    DoCmd.Minimize
        
Exit_ErrHandler:
    Exit Function
    
ErrHandler:
    MsgBox "Error " & Err.Number & " in HideNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_ErrHandler

End Function

Any help will be much appreciated. Thanks .
 

isladogs

MVP / VIP
Local time
Today, 18:58
Joined
Jan 14, 2017
Messages
18,216
As I previously stated, just copying chunks of code is not going to work
Much of the code you have included is not relevant to this specific item.
For example, you don't need the label - its not part of this code

What you do need, but clearly haven't included, is the relevant part of the Form_Timer event code

To speed things up, I've done a new example which just has the marquee text code & removed just about everything else

Please try to understand how the code works!
 

Attachments

  • ScrollingText.zip
    319.9 KB · Views: 27

Gasman

Enthusiastic Amateur
Local time
Today, 18:58
Joined
Sep 21, 2011
Messages
14,272
Colin,
I had a quick peek before I left work today.
Once you click the scrolling text button, if you click it again, is it meant to reset itself, in that the it stops and clears the scrolling text? or just pause the scrolling text?
 

isladogs

MVP / VIP
Local time
Today, 18:58
Joined
Jan 14, 2017
Messages
18,216
In the example I uploaded it just stops & hides the text which is written as a string in the code.

However it would be trivial to alter this so the text is cleared.

In the past I've used a table tblMessageText with fields ID, MessageText, StartDate, EndDate

Then when the button is clicked a DLookup identifies the current message and displays that

Code:
strText = Nz(DLookup("MessageText","tblMessageText","StartDate<=Now() And EndDate>=Now()"),"")

NOTE: In the real world, I don't use scrolling text to warn users the database is about to close for essential maintenance. I make it much more obvious with a deliberately 'loud' form including a countdown timer.
 

Attachments

  • LogoutStatus.PNG
    LogoutStatus.PNG
    17.3 KB · Views: 31

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
Thanks Ridders, Its working now. The only thing is as I am trying to scroll project name (which has just few letters) on the form. so txtMarquee stores "Recorded Delivery System" and it keeps on scrolling in a small place .. i want it to scroll from far right end to far left end so that its on the whole page .

Can this be done?

Thanks
 

isladogs

MVP / VIP
Local time
Today, 18:58
Joined
Jan 14, 2017
Messages
18,216
Make the textbox width the same as the form width.
You can also alter the scrolling speed by changing the timer interval if you want
 

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
I have made the textbox wider as the form width but it still its scrolling not to the whole width defind. I think its just scrolling to the total number of characters in the textbox .
 

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
Ridders, Can you pls check whats causing the issue? I have tried changing the timer and making width of textbox bigger but it still scrolling to small space...
 

isladogs

MVP / VIP
Local time
Today, 18:58
Joined
Jan 14, 2017
Messages
18,216
Aman
You really should be able to work out the solution yourself as there really is no magic to this ....

The original purpose of scrolling or marquee text is to allow a message wider than the available space to be displayed.

Think about how you would normally fill a textbox which is too big for its contents.
Two easy solutions below but in WHITE text - think of it as a cheat sheet. Look only if you can't work it out yourself

1. Increase the font size so it nearly fills the box
2. Leave a few spaces at the end of the text then repeat it ... if necessary more than once

OR use a different method entirely to get your message across e.g. flashing text
 

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
Thats great Ridders. Sorry one more thing have we used windows API to do this?

or is it Access function to scroll marquee text and we have just added timer?
 

Gasman

Enthusiastic Amateur
Local time
Today, 18:58
Joined
Sep 21, 2011
Messages
14,272
Pad out the end of the string with a required number of spaces?
 

aman

Registered User.
Local time
Today, 10:58
Joined
Oct 16, 2008
Messages
1,250
Gasman, I already made the text scrolling across. Just wondering if this is what we need
as below and timer along with it. Its really amazing :)

Code:
 DoCmd.NavigateTo "acNavigationCategoryObjectType"
 

isladogs

MVP / VIP
Local time
Today, 18:58
Joined
Jan 14, 2017
Messages
18,216
Thats great Ridders. Sorry one more thing have we used windows API to do this?

or is it Access function to scroll marquee text and we have just added timer?

@Aman
It doesn't need the API. That was for other parts of the original example
All the code is done using the form timer event.

You also don't need the 'navigate to' code.

@Gasman
Did you look at my cheat sheet items by any chance?
 
Last edited:

Users who are viewing this thread

Top Bottom