VBA/Excel/Access/Word/Forms/Form Events

Материал из VB Эксперт
Версия от 15:48, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

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>