This is an image of a Screen where a Reminder Ticker is active and scrolls with information as a continuous reminder. The Automotive Sales & Service Company enters into Vehicle Service Contracts with Corporate Customers for various periods and maintains the data in an MS-Access Database. Every month a few Vehicle Contracts are due for renewal and the Staff concerned are suppose to contact the Customers and check whether they would like to renew their Maintenance Contract with the Company. The Reminder Ticker displays the Customer Code, Vehicle Model, Chassis Number, Vehicle Description and Expiry Date (not yet moved into the visible area of the Ticker).

The Input Data for the Ticker is extracted from the Contract Table based on the Expiry Date falling within the current month, with the help of a Query. Customer Code, Vehicle Model Number, Chassis Number, Vehicle Description & Expiry Date Values of each contract record is concatenated into a Variant Variable (String Variable may limit the length of the String into 255 characters) and used for the Ticker with the help of Timer.

The VB Code is given below:

Option Compare Database
Option Explicit
'Global Declaration
Dim strTxt

Private Sub Form_Open(Cancel As Integer)
Dim db As Database, rst As Recordset
Dim rstcount As Integer, currMonth As Integer, marqMonth

On Error GoTo Form_Open_Err

currMonth = Month(Date)

' Expiry_Marque is a parameter Table which holds 
' the Start-Date & End-Date of Current Month and uses to pick
' the Contract Expiry Cases falls within this period.

marqMonth = Month(DLookup("ExpDateTo", "Expiry_Marque"))

If currMonth <> marqMonth Then

' when the month is changed the parameter table is 
' updated with changed period.
' i.e. Start-Date and End-Date of the Current Month

DoCmd.SetWarnings False
DoCmd.OpenQuery "Expiry_Marque_Updt", acViewNormal
DoCmd.SetWarnings True
End If

'checks whether any contract expiry cases are there
'during the month.

rstcount = dCount("*", "Expiry_MarqueQ")

If Nz(rstcount, 0) = 0 Then

strTxt = String(60, " ") & "*" NO CONTRACT EXPIRY CASES FOR " 
strTxt = strTxt & Format(Date, "mmmm yyyy") & " **"

GoTo Form_Open_Exit
End If

' builds the String strTxt with ticker data.

Set db = CurrentDb
Set rst = db.OpenRecordset("Expiry_MarqueQ", dbOpenDynaset)

strTxt = String(60, " ") & "Expiry Cases: "

Do While Not rst.EOF

With rst
  strTxt = strTxt & " ** {" & rst.AbsolutePosition + 1 & "}. CUST: ["
  strTxt = strTxt & ![CUST_COD] & "] MODEL :[" & ![MODL_COD]
  strTxt = strTxt & "]  CHAS :[" & ![CHASSIS] & "](" & ![DESC]
  strTxt = strTxt & ") EXP.: " & ![EXP_DATE]
End With

rst.MoveNext

Loop

rst.Close

'A Text Box on the Form is set with the Total Number
'of Contracts getting expired.

Me![mVehl] = rstcount & " Vehicles."

' the Timer is invoked and the time to refresh 
' the control is set with quarter of a
' second. This value may be modified.

Me.TimerInterval = 250
Set rst = Nothing
Set db = Nothing

Form_Open_Exit:
Exit Sub

Form_Open_Err:
MsgBox Err.Description, ,"Form_Open"
Resume Form_Open_Exit
End Sub


Private Sub Form_Timer()
Dim x

On Error GoTo Form_Timer_Error

x = Left(strTxt, 1)

strTxt = Right(strTxt, Len(strTxt) - 1)

strTxt = strTxt & x

' Create a Label with the Name lblmarq 
' on your Form to scroll the values
' The value 200 used in the Left Function may be
' modified based on the length of the
' Label. Format the Label with a fixed width font
' like Courier New so that you can correctly determine
' how many characters can be displayed on the legth
' of the Label at one time and change the value accordingly.

lblmarq.Caption = Left(strTxt, 200)

Form_Timer_Exit:
Exit Sub

Form_Timer_Error:
MsgBox Err.Description, , "Form_Timer_Error"
Resume Form_Timer_Exit

End Sub

When the Form become inactive after opening other Forms, deactivate the Ticker. When nobody is watching no point in running the Program. When the Form become active again then re-activate the ticker. To do this add the following Code into the Form Module:

Private Sub Form_Deactivate()
    Me.TimerInterval = 0
End Sub

Private Sub Form_Activate()
Me.TimerInterval = 250
End Sub

---

Download Demo Database

---

File Browser in Access
MsgBox with Office Assistant
Create 3D Headings on Forms/Reports

Labels: msaccess animation