Make the text in a textbox scrolling horizontally in a form

A

aman

Registered User.
Local time
Today, 03:50
Joined
Oct 16, 2008
Messages
1,251
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
 
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?
 
CJ_London said:
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?
Click to expand...

Yes I want this on the home page. How can this be done? Thanks
 
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
 
idders, its not working foe me. Text is not scrolling on the page . I have written the following code on Homepage:
Click to expand...

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:
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 .
 
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

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?
 
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: 82
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
 
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
 
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 .
 
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...
 
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
 
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?
 
Pad out the end of the string with a required number of spaces?
 
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"
 
aman said:
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?
Click to expand...

@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:
You must log in or register to reply here.

Similar threads

D
Opening record by ID opens a new record
Replies
8
Views
453
Mark_
M
Technics
Access Continuous Form Report
Replies
5
Views
342
Technics
Technics
T
Solved Sum the data in a textbox in continous form
Replies
13
Views
1,454
liam_thompson
L
D
My mouse wheel cannot scroll the height of my form when my cursor is atop my continuous subform. Can I always have main form vertical scroll control?
Replies
13
Views
1,348
diamondDog
D
B
Form sizing / scrolling for smaller screens
Replies
9
Views
593
isladogs
isladogs

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom