Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to prevent users from leaving current record by scrolling the Mouse Wheel

User Interface Techniques

How to prevent users from leaving current record by scrolling the Mouse Wheel

by  jollygood  Posted    (Edited  )
If you have made a form where you don't whant your users to be able to scroll between records using the Mouse Wheel then this is for you.
[highlight]For those of you who have been here before. There are important changes in this faq.[/highlight]

[highlight]This technique only works in "Form View" and I have only tried it on Access 2002/XP.[/highlight]

Step 1.
On your form, place an unbound Text Box with the following properties:
Visible = Yes
Back Style = Transparent
Back Color = -2147483633
Special Effect = Flat
Border Style = Transparent
Default Value = " "
Validation Rule = WheelSpin()=False
[Green]'This setting is removed Validation Text = You can't change record using your mouse wheel![/Green]
Enabled = Yes
Locked = No
Name = UnboundTextBox

Step 2.
Then for your Form Properties set this:
On Mouse Wheel = [Event Procedure]
On Error = [Event Procedure]

Step 3.
Place the following code behind your form:
Code:
[Green]
'Global declarations should be here before the code

'This enum is for clarifying the code below.[/Green]
[blue]Private Enum[/blue] wsTrigger
   MyWheel = 1
   NotTheWheel = 2
[blue]End Enum[/blue]

[blue]Private[/blue] mWheel [blue]As Boolean[/blue]
[blue]Private[/blue] ValidationTrigger [blue]As[/blue] wsTrigger
[green]
'End of global declarations [/green]

[blue]Private Function[/blue] WheelSpin() [blue]As Integer[/blue]
   WheelSpin = mWheel
   [blue]Select Case[/blue] ValidationTrigger
      [blue]Case[/blue] NotTheWheel
         mWheel = [blue]False
   End Select
End Function

Private Sub[/blue] Form_Error(DataErr [blue]As Integer[/blue], Response [blue]As Integer[/blue])
   [blue]If[/blue] Screen.ActiveControl.Name = "UnboundTextBox" [blue]Then[/blue]
      Response = acDataErrContinue
   [blue]End If
End Sub 

Private Sub[/blue] Form_MouseWheel([blue]ByVal[/blue] Page [blue]As Boolean[/blue], [blue]ByVal[/blue] Count [blue]As Long[/blue])
[blue]On Error GoTo[/blue] Sub_Err
   mWheel = True
   ValidationTrigger = MyWheel
   Me.UnboundTextBox.SetFocus
   Me.UnboundTextBox.TEXT = " "
Sub_Exit:
   ValidationTrigger = NotTheWheel
   [blue]Exit Sub[/blue]
Sub_Err:
   [blue]Resume[/blue] Sub_Exit
[blue]End Sub[/blue]

Thats it!

Have fun
/jollygood ;-)
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top