Decision making in VBA

1
Decision making in VBA
2
Current Event

• Occurs
• When a form is opened
• When the focus leaves one record and moves to
  another
• Before the first or next record is displayed

3
Disable next record button
Private Sub Form_Current() If Me.NewRecord
True Then cmdPrevRec.SetFocus
cmdNextRec.Enabled False End If End Sub
4
Re-enable next record button
Private Sub Form_Current() If Me.NewRecord True
Then cmdPrevRec.SetFocus
cmdNextRec.Enabled False Else
cmdNextRec.Enabled True End If End Sub
5
Disable previous record button
Private Sub Form_Current() If Me.NewRecord True
Then cmdPrevRec.Enabled True
cmdPrevRec.SetFocus cmdNextRec.Enabled
False ElseIf Me.CurrentRecord 1 Then
cmdNextRec.Enabled True cmdNextRec.SetFocus
cmdPrevRec.Enabled False Else
cmdNextRec.Enabled True cmdPrevRec.Enabled
True End If End Sub
6
Trappable errors

• Can occur while application is running
• Each has a unique error number
• Type Trappable errors in VBA help to get
  complete listing
• When these errors occur for a form (or report) we
  can use the objects Error event to respond to
  them.

7
Display error number
Private Sub Form_Error(DataErr As Integer,
Response As Integer) MsgBox DataErr End Sub
8
Code to handle trappable errors
Private Sub Form_Error(DataErr As Integer,
Response As Integer) Select Case DataErr
Case 2237 MsgBox "You have entered
a title that is not in the list. _ Click
the list and choose one of the options shown."
Response acDataErrContinue
Case 3314 MsgBox "You must enter both
first and last name for the employee. _
Fill in the missing value." Response
acDataErrContinue Case 3317
MsgBox "Employee start date must be today's date
or earlier. _ Please enter a valid date"
Response acDataErrContinue
Case Else 'the default error handler displays VBA
error message Response
acDataErrDisplay End Select End Sub
9
Control Wizard error-handling
Private Sub cmdNextRec_Click() On Error GoTo
Err_cmdNextRec_Click DoCmd.GoToRecord , ,
acNext Exit_cmdNextRec_Click Exit
Sub Err_cmdNextRec_Click MsgBox
Err.Description Resume Exit_cmdNextRec_Click
End Sub
10
Function without error handling
Public Sub TestErrors() Dim dblResult As
Double dblResult 10 / InputBox("Enter
a number") MsgBox "The result is "
dblResult End Sub
11
Error handling added
Public Sub TestErrors2() On Error GoTo
Err_TestErrors Dim dblResult As Double
dblResult 10 / InputBox("Enter a number")
MsgBox "The result is " dblResult
Exit_TestErrors Exit Sub Err_TestErrors
Select Case Err.Number Case 11
'division by zero dblResult 0
Resume Next Case 13 'type mismatch
Resume Case Else
MsgBox Err.Number " " Err.Description
Resume Exit_TestErrors End Select End Sub
12
Select Case statement

• Syntax
• Select Case testexpressionCase
  expressionlist-nstatements-n ...Case
  Elseelsestatements
• End Select

13
Select Case Example
Public Function Discount(curAmount As Currency)
Select Case curAmount Case Is gt 100
MsgBox "10 discount" Case Is
gt 50 MsgBox "5 discount"
Case Else MsgBox "No discount"
End Select End Function