VBA/Excel/Access/Word/Forms/Form Events
Содержание
- 1 Assign form Recordset in its open action
- 2 CancelEvent: DoCmd.CancelEvent()
- 3 Code for the Add Button
- 4 Code for the Find Button
- 5 Code for the Move Next Button
- 6 Code for the Move Previous Button
- 7 Deleting a Record
- 8 Form Before Update action
- 9 Form_Filter
- 10 If the data in the form dirty
- 11 IsLoad function
- 12 Key down event
- 13 The Load Event Assigning a Recordset Object to the Form
- 14 The Undo event executes before changes to a row are undone.
- 15 Writing the Form_Error Event Procedure
- 16 You can not only check how the filter was invoked, but you can also intercept the process when the filter is applied.
Assign form Recordset in its open action
<source lang="vb">
Private Sub Form_Open(Cancel As Integer)
Dim con As ADODB.Connection Dim myRecordset As ADODB.Recordset Dim strFrmNm As String Set myRecordset = New ADODB.Recordset myRecordset.CursorType = adOpenKeyset myRecordset.LockType = adLockOptimistic Set con = New ADODB.Connection con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\store.mdb;" myRecordset.Open "SELECT * FROM Employees", con Set Me.Recordset = myRecordset myRecordset.Close con.Close Set myRecordset = Nothing Set con = Nothing
End Sub
</source>
CancelEvent: DoCmd.CancelEvent()
<source lang="vb">
Private Sub Form_BeforeUpdate(Cancel As Integer)
If MsgBox("Are you sure you want to save changes to this record?", _ vbYesNo Or vbInformation, "Confirm Upate") = vbNo Then DoCmd.CancelEvent End If
End Sub
</source>
Code for the Add Button
<source lang="vb">
Private Sub cmdAdd_Click()
"Add a new row to the recordset Me.Recordset.AddNew Me.Recordset("CompanyName") = "New Company" Me.Recordset.Update "Move to the row that was added Me.Bookmark = Me.Recordset.Bookmark
End Sub
</source>
Code for the Find Button
<source lang="vb">
Private Sub cmdFind_Click()
Dim strClientID As String Dim varBookmark As Variant varBookmark = Me.Recordset.Bookmark strClientID = InputBox("Enter Client ID of Client You Want to Locate") Me.Recordset.Find "ClientID = " & strClientID, Start:=1 If Me.Recordset.EOF Then MsgBox "Client ID " & strClientID & " Not Found!!" Me.Recordset.Bookmark = varBookmark Else Me.Bookmark = Me.Recordset.Bookmark End If
End Sub
</source>
Code for the Move Next Button
<source lang="vb">
Private Sub cmdNext_Click()
Me.Recordset.MoveNext If Me.Recordset.EOF Then Me.Recordset.MovePrevious MsgBox "Already at Last Record!!" End If Me.Bookmark = Me.Recordset.Bookmark
End Sub
</source>
Code for the Move Previous Button
<source lang="vb">
Private Sub cmdPrevious_Click()
Me.Recordset.MovePrevious If Me.Recordset.BOF Then Me.Recordset.MoveNext MsgBox "Already at First Record!!" End If Me.Bookmark = Me.Recordset.Bookmark
End Sub
</source>
Deleting a Record
<source lang="vb">
Private Sub cmdDelete_Click()
"Ask user if he really wants to delete the row intAnswer = MsgBox("Are You Sure???", _ vbYesNo + vbQuestion, _ "Delete Current Record?") "If he responds yes, delete the row and "move to the next row If intAnswer = vbYes Then Me.Recordset.Delete Call cmdNext_Click Me.Refresh End If
End Sub
</source>
Form Before Update action
<source lang="vb">
Private Sub Form_BeforeUpdate(Cancel As Integer)
If IsNull(Me.txtContactFirstName) Or _ IsNull(Me.txtContactLastName) Or _ IsNull(Me.txtCompanyName) Or _ IsNull(Me.txtPhoneNumber) Then MsgBox "The Contact First Name, " & vbCrLf & _ "Contact Last Name, " & vbCrLf & _ "Company Name, " & vbCrLf & _ "And Contact Phone Must All Be Entered", _ vbCritical, _ "Canceling Update" Me.txtContactFirstName.SetFocus Cancel = True End If
End Sub
</source>
Form_Filter
<source lang="vb">
Private Sub Form_Filter(Cancel As Integer, FilterType As Integer)
Select Case FilterType Case acFilterByForm MsgBox "You Just Selected Filter By Form" Case acFilterAdvanced MsgBox "You Are Not Allowed to Select Advanced Filter/Sort" Cancel = True End Select
End Sub
</source>
If the data in the form dirty
<source lang="vb">
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
"If the form is dirty and the user presses page up or "page down, ignore the keystroke If Me.Dirty Then If KeyCode = vbKeyPageDown Or _ KeyCode = vbKeyPageUp Then KeyCode = 0 End If End If
End Sub
</source>
IsLoad function
<source lang="vb">
Sub m()
If Not IsLoaded("frmClients") Then msgBox "You must load this form from the Projects form", _ vbCritical, "Warning" End If
End Sub Public Function IsLoaded(strFormName As String) As Boolean
Const FORMOPEN = -1 Const FORMCLOSED = 0 If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> FORMCLOSED Then IsLoaded = True Else IsLoaded = False End If
End Function
</source>
Key down event
<source lang="vb">
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Me.Dirty Then If KeyCode = vbKeyPageDown Or _ KeyCode = vbKeyPageUp Then KeyCode = 0 End If End If
End Sub
</source>
The Load Event Assigning a Recordset Object to the Form
<source lang="vb">
Private Sub Form_Load()
Dim rst As ADODB.Recordset Set rst = New ADODB.Recordset rst.ActiveConnection = CurrentProject.Connection rst.CursorType = adOpenKeyset rst.CursorLocation = adUseClient rst.LockType = adLockOptimistic rst.Open "Select * from tblClients", Options:=adCmdText Set Me.Recordset = rst
End Sub
</source>
The Undo event executes before changes to a row are undone.
<source lang="vb">
Private Sub Form_Undo(Cancel As Integer)
If MsgBox("You Have Attempted to Undo Changes " & _ "to the Current Row. Would You Like to Proceed " & _ "with the Undo Process?", _ vbYesNo) = vbYes Then "If he responds yes, proceed with the undo Cancel = False Else "If he responds no, cancel the undo Cancel = True End If
End Sub
</source>
Writing the Form_Error Event Procedure
<source lang="vb">
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim custId As String Const conDuplicateKey = 3022 If DataErr = conDuplicateKey Then Response = acDataErrContinue Debug.Print "Customer " & custId & " already exists." End If
End Sub
</source>
You can not only check how the filter was invoked, but you can also intercept the process when the filter is applied.
<source lang="vb">
Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)
Dim intAnswer As Integer If ApplyType = acApplyFilter Then intAnswer = MsgBox("You just selected the criteria: " & _ Chr(13) & Chr(10) & Me.Filter & _ Chr(13) & Chr(10) & "Are You Sure You Wish " & __ to Proceed?", vbYesNo + vbQuestion) If intAnswer = vbNo Then Cancel = True End If End If
End Sub
</source>