اجبار الكود على الذهاب للبداية عند النقر على الزر

[الحاتمي1]

السلام عليكم ورحمة الله وبركاته 

عندي نموذج قاعدة بيانات اكسس 

في حدث النقر على زر الحفظ يقوم بداية بفحص الحقل اذا كان فارغا او لا 

اذا كان فارغا فانه يرجع رسالة تنبيهيه بضرورة كتابة المطلوب في حقل النصي 

واذا وجد ان الحقل به كتابة يقوم بعملية الحفظ 

 

ولكن بعد عملية النقر الاولى لاحظت ان الزر لا يقوم بالتأكد من الشرط من جديد وانما يتجاهله ويحاول حفظ مباشرة 

 

السؤال كيف اخلي الكود في كل عملية نقر يقوم بالذهاب لبداية الكود ويبحث عن الشرط ويطلب تحقيقه ولا يكمل الحفظ حتى لا يدخل حقول فارغه

1234.accdb

[Eng.Qassim]

وعليكم السلام

اجعل كود الحفظ هكذا

 If IsNull(Me.sname) Or Me.sname = "" Then
        MsgBox "لا يمكن ترك حقل الاسم فارغا.", vbCritical, "Error"
        Me.sname.SetFocus
        Exit Sub
    End If
    If IsNull(Me.sage) Or Me.sage = "" Then
        MsgBox "لا يمكن ترك حقل العمر فارغا", vbCritical, "Error"
        Me.sage.SetFocus
        Exit Sub
    End If

    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenDynaset)
    With rst
        .AddNew
        ![sname] = Me.sname
        ![sage] = Me.sage
        .Update
        .Close
    End With
    Set rst = Nothing
    db.Close
    Set db = Nothing
    Me.sname = ""
    Me.sage = ""

 

[AbuuAhmed]

وهذه طريقتي في كود الإضافة والبحث والذهاب إلى آخر سجل.
 

Option Compare Database
Option Explicit

Private Sub btnsave_Click()
    Dim db As DAO.Database
    Dim rst As Recordset
    
    On Error Resume Next
    
    If Nz(Me.sname, "") = "" Or Nz(Me.sage, "") = "" Then
        MsgBox "لا يمكن ترك احد الحقول فارغا"
        Screen.PreviousControl.SetFocus
        Exit Sub
    End If

    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenDynaset)
    
    With rst
        Err.Clear
        .AddNew
            !sname = Me.sname
            !sage = Me.sage
        .Update
        
        If Err.Number = 0 Then
            Me.sname = Null
            Me.sage = Null
            Me.sname.SetFocus
        Else
            MsgBox Err.Description, , Err.Number
        End If
    End With

    Set rst = Nothing
    Set db = Nothing
End Sub

Private Sub btnview_Click()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    On Error Resume Next
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenSnapshot)
    
    With rst
        .FindFirst "sname='" & Nz(Me.sname, "") & "' And sage=" & Nz(sage, 0)
        If Not .NoMatch Then
            Me.ID = !ID
        Else
            MsgBox "لا يوجد سجل بهذه البيانات"
        End If
    End With
    
    Set rst = Nothing
    Set db = Nothing
End Sub

Private Sub cmdLastRec_Click()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    On Error Resume Next
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenSnapshot)
    
    With rst
        .MoveLast
        
        Me.ID = !ID
        Me.sname = !sname
        Me.sage = !sage
    End With

    Set rst = Nothing
    Set db = Nothing
End Sub

 

Test_01.accdb

[الحاتمي1]

في 9‏/2‏/2023 at 17:14, Eng.Qassim said:

وعليكم السلام

اجعل كود الحفظ هكذا

 If IsNull(Me.sname) Or Me.sname = "" Then
        MsgBox "لا يمكن ترك حقل الاسم فارغا.", vbCritical, "Error"
        Me.sname.SetFocus
        Exit Sub
    End If
    If IsNull(Me.sage) Or Me.sage = "" Then
        MsgBox "لا يمكن ترك حقل العمر فارغا", vbCritical, "Error"
        Me.sage.SetFocus
        Exit Sub
    End If

    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenDynaset)
    With rst
        .AddNew
        ![sname] = Me.sname
        ![sage] = Me.sage
        .Update
        .Close
    End With
    Set rst = Nothing
    db.Close
    Set db = Nothing
    Me.sname = ""
    Me.sage = ""

 

 

في 10‏/2‏/2023 at 22:10, AbuuAhmed said:

وهذه طريقتي في كود الإضافة والبحث والذهاب إلى آخر سجل.
 

Option Compare Database
Option Explicit

Private Sub btnsave_Click()
    Dim db As DAO.Database
    Dim rst As Recordset
    
    On Error Resume Next
    
    If Nz(Me.sname, "") = "" Or Nz(Me.sage, "") = "" Then
        MsgBox "لا يمكن ترك احد الحقول فارغا"
        Screen.PreviousControl.SetFocus
        Exit Sub
    End If

    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenDynaset)
    
    With rst
        Err.Clear
        .AddNew
            !sname = Me.sname
            !sage = Me.sage
        .Update
        
        If Err.Number = 0 Then
            Me.sname = Null
            Me.sage = Null
            Me.sname.SetFocus
        Else
            MsgBox Err.Description, , Err.Number
        End If
    End With

    Set rst = Nothing
    Set db = Nothing
End Sub

Private Sub btnview_Click()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    On Error Resume Next
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenSnapshot)
    
    With rst
        .FindFirst "sname='" & Nz(Me.sname, "") & "' And sage=" & Nz(sage, 0)
        If Not .NoMatch Then
            Me.ID = !ID
        Else
            MsgBox "لا يوجد سجل بهذه البيانات"
        End If
    End With
    
    Set rst = Nothing
    Set db = Nothing
End Sub

Private Sub cmdLastRec_Click()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    On Error Resume Next
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tbltest", dbOpenSnapshot)
    
    With rst
        .MoveLast
        
        Me.ID = !ID
        Me.sname = !sname
        Me.sage = !sage
    End With

    Set rst = Nothing
    Set db = Nothing
End Sub

 

Test_01.accdb 472 kB · 4 downloads

السلام عليكم جميعا

 

اولا شكرا لكم على الاضافة استفدت كثيرا من الاكواد

 

تكرما اذا فيه مجال 

اريد كود لتحديث سجل تمت اضافته سابقا وايضا حذف سجل  بوجود شرط ID حتى لا يحذف او يعدل الكل دفعة واحدة

تم تعديل فبراير 12, 2023 بواسطه الحاتمي1

[الحاتمي1]

للتذكير اخواني الاعزاء