نمونه های کاربردی و آموزشی VBA

[سعید مشکین فر]

'ابتدا

'کلیدهای اولین رکورد ،آخرین رکورد،رکورد قبل،رکورد بعد،رکورد و رکورد جدید را

'روی فرم خودتان طراحی کنید

'کدها را در رویداد کلیک هر دکمه فرمان کپی کنید

'*************************************************  **********

'This code builds a set of Navigation Buttons consisting of:

'First, Next, Previous, Last, and New

'*************************************************  **********

Private Sub cmdFirst_Click()

    On Error GoTo Err_cmdFirst_Click



    DoCmd.GoToRecord , , acFirst

    Me.ID_NO.SetFocus



Exit_cmdFirst_Click:

    Exit Sub



Err_cmdFirst_Click:

    MsgBox Err.Description

    Resume Exit_cmdFirst_Click



End Sub



Private Sub cmdLast_Click()

    On Error GoTo Err_cmdLast_Click



    DoCmd.GoToRecord , , acLast

    Me.ID_NO.SetFocus

    'قرار دهید ID_NO نام فیلد خودتان را بجای



Exit_cmdLast_Click:

    Exit Sub



Err_cmdLast_Click:

    MsgBox Err.Description

    Resume Exit_cmdLast_Click



End Sub



Private Sub cmdNew_Click()

    On Error GoTo Err_cmdNew_Click



    DoCmd.GoToRecord , , acNewRec



Exit_cmdNew_Click:

    Exit Sub



Err_cmdNew_Click:

    MsgBox Err.Description

    Resume Exit_cmdNew_Click



End Sub



Private Sub cmdNext_Click()

    On Error GoTo Err_cmdNext_Click



    DoCmd.GoToRecord , , acNext

    Me.ID_NO.SetFocus

    'قرار دهید ID_NO نام فیلد خودتان را بجای



Exit_cmdNext_Click:

    Exit Sub



Err_cmdNext_Click:

    Call EndTable

    Resume Exit_cmdNext_Click



End Sub



Private Sub cmdPrevious_Click()

    On Error GoTo Err_cmdPrevious_Click



    DoCmd.GoToRecord , , acPrevious

    'قرار دهید ID_NO نام فیلد خودتان را بجای

    Me.ID_NO.SetFocus



Exit_cmdPrevious_Click:

    Exit Sub



Err_cmdPrevious_Click:

    Call StartTable

    Resume Exit_cmdPrevious_Click



End Sub



'کدها را در رویداد Current کپی کنید



Private Sub Form_Current()

On Error GoTo Err_Form_Current

    Dim recClone As Object

    Dim intNewRecord As Integer



    ' Do magic tricks with the form's caption!

    If Me.NewRecord Then

        ' Use appropriate prompt for your database.

        Me.Caption = "رکورد جدید: لطفا اطلاعات رکورد را وارد کنید"

    Else

        Me.Caption = " شماره صفحه فعلی: " & Me!ID_NO.Value     'قرار دهید ID_NO نام فیلد خودتان را بجای



    End If



    ' If this is a "New Record" then

    ' Disable the <Next>, <New>, <Last> buttons

    ' Enable the <First> and <Next> buttons

    ' Then Exit the procedure.

    intNewRecord = IsNull(Me![ID_NO])

    If intNewRecord Then

        cmdFirst.Enabled = True

        cmdNext.Enabled = False

        cmdPrevious.Enabled = True

        cmdLast.Enabled = False

        cmdNew.Enabled = False

        Me![RecordCount] = "ثبت رکورد جدید"

        Me.ID_NO.SetFocus    ' Set focus to the PasNo if a "New Record"

        Exit Sub

    Else

        ' Else if this is not a new record

        ' Enable <New> and <Last> buttons

        cmdNew.Enabled = True

        cmdLast.Enabled = True

    End If



    ' Make a clone of the recordset underlying the form so

    ' we can move around without affecting the form's recordset

    Set recClone = Me.RecordsetClone



    ' Check to see if there are no records

    ' If so disable all buttons except for the <New> button

    If recClone.RecordCount = 0 Then

        cmdNext.Enabled = False

        cmdPrevious.Enabled = False

        cmdFirst.Enabled = False

        cmdLast.Enabled = False

    Else

        ' Synchronise the current pointer in the two recordsets

        recClone.Bookmark = Me.Bookmark

        ' If there are records, see if recordset is on the first record

        ' If so, disable the <First> and <Previous> buttons

        recClone.MovePrevious

        cmdFirst.Enabled = Not (recClone.BOF)

        cmdPrevious.Enabled = Not (recClone.BOF)

        recClone.MoveNext

        ' And then check whether recordset is on the last record

        ' If so, disable the <Last> and <Next> buttons

        recClone.MoveNext

        cmdLast.Enabled = Not (recClone.EOF)

        cmdNext.Enabled = Not (recClone.EOF)

        recClone.MovePrevious

    End If



    Me![RecordCount] = "رکورد " & (recClone.AbsolutePosition + 1) & " از " & _

                       DCount("ID_NO", "[MainTable]")

    'قرار دهید MainTable نام تیبل خودتان را بجای



    recClone.Close



Exit_Form_Current:

    Exit Sub



Err_Form_Current:

    If Err = 3021 Then

        ' Error 3021 means recordset is at Add New Record

        ' Enable <Previous> and <First> buttons

        ' Disable <Next> and <Last> buttons

        cmdPrevious.Enabled = True

        cmdFirst.Enabled = True

        cmdNext.Enabled = False

        cmdLast.Enabled = False

        Resume Exit_Form_Current

    Else

        MsgBox Err.Description

        Resume Exit_Form_Current

    End If

End Sub