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

[saeedyaz]

بستن کلید شیفت :

Public Function SetAllowBypassKeyFalse()

 

'----- کنترل خطا

On Error GoTo Err_SetAllowBypassKeyFalse

 

 

Dim db As DAO.Database, prp As DAO.Property

 

'----- در صورت موجود بودن Property ست کردن

Set db = CurrentDb

 

db.Properties("AllowBypassKey") = False

 

Set db = Nothing

 

 

Exit_SetAllowBypassKeyFalse:

 

Exit Function 

 

'----- کنترل خطا

Err_SetAllowBypassKeyFalse:

 

'-----   خطا در صورت موجود نبودن Property

     '-----  اگر قبلاً ساخته نشده Property ساخت

If Err = 3270 Then    

 

Set prp = db.CreateProperty("AllowBypassKey", dbBoolean, False)

db.Properties.Append prp

 

Resume Next

 

Else

 

'----- در صورت بروز خطاهای غیر منتظره

MsgBox "SetAllowBypassKeyFalse", Err.Number, Err.Description

 

Resume Exit_SetAllowBypassKeyFalse

 

End If

 

End Function

 

مهندس این کد رو چه جوری اجرایی کنم تو on loud یا جای دیگه....

[مهدی قربانی]

سلام
اين كد رو اول توي يك ماجول كپي و ذخيره كنيد ، بعد مثلاً در لود فرم اصلي برنامه يا يك كامند باتون اين عبارت رو بنويسيد : SetAllowBypassKeyFalse
البته اگر يك بار اين ماجول اجرا بشه ديگه براي هميشه شيفت بسته ميشه و احتياجي نيست كه هر بار برنامه لود ميشه اين عمل تكرار بشه بنابر اين مي تونيد يك فرم در فايل بذاريد به همراه كامند باتون كه فقط در صورت نياز بهش رجوع كنيد . ويك نكته مهم اينكه حتماً قبل از بستن شيفت يك كپي لز فايل رو در جايي ذخيره كنيد .

[amirzazadeh]

نمونه آموزشي براي مديريت فيلدهاي الزامي با پيام هاي فارسي
لطفا فايل ضميمه رو ببينيد:
درصورت عدم ورود فيلدهاي الزامي پيام خطا صادر ميگردد

Option Compare Database



Private Sub Form_Error(DataErr As Integer, Response As Integer)



'If an error occurs because of missing data in a required field

'display our own custom error message



   Const conErrRequiredData = 3314

 Const conErrNotSavedData = 2169

    

    If DataErr = conErrRequiredData Then

      MsgBox ("درج اطلاعات در اين فيلد الزامي است")

             

                  If IsNull(Me.NationalId) Then

                  Me.NationalId.SetFocus

                 Me.NationalId.BackColor = vbYellow

                 

                 ElseIf IsNull(Me.tel) Then

                Me.tel.SetFocus

                 Me.tel.BackColor = vbYellow

             End If

        Response = acDataErrContinue

      ElseIf DataErr = conErrNotSavedData Then

          MsgBox ("داده ذخيره نشد")

           Response = acDataErrContinue

      Else

        'Display a standard error message

        Response = acDataErrDisplay

    End If

End Sub



Private Sub NationalId_AfterUpdate()

   Me.NationalId.BackColor = vbWhite

End Sub



Private Sub tel_AfterUpdate()

 Me.tel.BackColor = vbWhite

End Sub