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

[smderfan]

هنگام طراحی فرم های جدید در پایگاه داده اکسس حتماً توجه کرده اید که اکسس، مشخصه Allow Design Changes را به صورت پیش فرض برابر All View قرار می دهد. به کمک این ویژگی، در هنگام طراحی فرم می توانید مشخصه ای از فرم یا شی کنترلی را مستقیماً در نمای فرم تغییر دهید و نتایج را بلافاصله مشاهده کنید.
هنگامی که برنامه آماده استفاده می شود باید مقدار این مشخصه را در همه فرم ها برابر Design View Only قرار دهید.
روال زیر کلیه فرم های موجود در پایگاه داده را پیدا و مشخصه مورد نظر را تغییر می دهد.

Sub FixAllowDesign()

 Dim objFrm As AccessObject, frm As Form

     ' Go through every form in the database

     For Each objFrm In CurrentProject.AllForms

         ' Open the form in Design view

         DoCmd.OpenForm FormName:=objFrm.Name, _

           View:=acDesign

         ' Set the form object for efficiency

         Set frm = Forms(objFrm.Name)

         ' Check and reset the AllowDesignChanges property

         If frm.AllowDesignChanges = True Then

             frm.AllowDesignChanges = False

             ' Save the change

             DoCmd.RunCommand acCmdSave

         End If

         ' Close the form

         DoCmd.Close acForm, objFrm.Name

     ' Loop to the next form

     Next objFrm

End Sub

[amirzazadeh]

دوستان نمونه حاضر براي Restore كردن پشتيبان هاي گرفته شده از بانك اطلاعاتي كاربرد دارد . اميدوارم مفيد باشه.(با اين تذكر كه رفرنسهاي تصوير ضميمه بايد add بشه براي اين منظور OCX ضميمه رو توي SYSTEM32 ويندوز كپي كنين و بعد توي اكسس از منوي TOOLS>ACTIVEX CONTROLS رجيستر كنيد.)

Option Compare Database

Dim CommondialogControl2 As Control

Dim backfile As New FileSystemObject

Dim source As String, desti As String

    

Private Sub Command0_Click()

On Error GoTo err

'    Dim source As String, desti As String

  source = Application.CurrentProject.path & "\fdc.mdb"

    With CommonDialog2

        .DialogTitle = "Backup"

        .Filter = "mdbfles (*.mdb)|*.mdb"

        .ShowSave

        desti = .FileName

         backfile.CopyFile source, desti, True

    MsgBox "Databas has been backup", vbInformation

    End With

Exit Sub

err:

Beep

End Sub



Private Sub Command1_Click()

On Error GoTo err

    desti = Application.CurrentProject.path & "\fdc.mdb"

    If MsgBox("are you sure", vbOKCancel, "restore") = vbOK Then

With CommonDialog2

    

    .DialogTitle = "Restore"

    .Filter = "Access Files(*.mdb)|*.mdb"

    .ShowOpen

    source = .FileName

End With

backfile.CopyFile source, desti, True

 MsgBox "Databas has been restored", vbInformation

 Else

 Cancel = True

 End If

Exit Sub

err:

Beep

End Sub

...........................
موفق باشيد