سامي الحداد

اعتذر اخي الكريم لقد وضعت مثالا غير صحيح اليك الملف 

الكنترول المدرسى.mdb

تفضل اخي الكريم  هل هو المطلوب

الكنترول المدرسى.mdb

 أخي الكريم 

من الخطاء جعل حقل رقم الموظف ترقيم تلقائي لانك ستواجه مشاكل كثيرة في ال TempVars من خلال ال Dlookup.   

اليك هذا التعديل في اكواد المودولات Emp_Var و Module2 

' Emp_Var Module

Option Compare Database
Option Explicit

Public Sub EmpNameVar()
    Dim EmpNameTemp As Variant

    If Not IsNull([TempVars]![EmpIdTemp]) And [TempVars]![EmpIdTemp] <> "" Then
    
        Dim empId As Long
        empId = CLng([TempVars]![EmpIdTemp])
        EmpNameTemp = DLookup("[emp_name]", "[tblName]", "[emp_code]=" & empId)
        TempVars.Add "EmpNameTemp", EmpNameTemp
    End If
End Sub

Public Function Totalcountt() As Integer
    Dim x As Integer
    x = DCount("[emp_code]", "tblName", "[job_Status]=1")
    Totalcountt = x
End Function


' Module2

Option Compare Database
Option Explicit

Function TotalVac()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim CountRecord As Integer
    Dim i, s As Integer

    Set db = CurrentDb
  
    If Not IsNull([TempVars]![EmpIdTemp]) Then
        
        Dim empId As String
        empId = "'" & CStr([TempVars]![EmpIdTemp]) & "'"

        Set rs = db.OpenRecordset("SELECT * FROM tblVacation WHERE (((tblVacation.EmpCode) = " & empId & " AND (tblVacation.VacationLife) = 'سارية')) ORDER BY vacationstartdate Asc;")
        Set rs1 = db.OpenRecordset("SELECT * FROM tblVacation WHERE (((tblVacation.EmpCode) = " & empId & " AND (tblVacation.VacationLife) = 'سارية')) ORDER BY vacationstartdate Asc;")

        
        On Error Resume Next
        db.TableDefs.Delete "vac"
        On Error GoTo 0

        Dim strSQL As String

        strSQL = "SELECT * INTO vac FROM tblVacation " & _
                 "WHERE (((tblVacation.EmpCode) = " & empId & " AND (tblVacation.VacationLife) = 'سارية')) " & _
                 "ORDER BY vacationstartdate ASC;"
        db.Execute strSQL

        rs.Close
        Set rs = Nothing
        rs1.Close
        Set rs1 = Nothing
    Else
      '  (يمكنك إظهار رسالة أو تنفيذ أي إجراء آخر حسب الحاجة)
       
    End If

    Set db = Nothing
End Function

تأخرت  عليك بالرد لان الوقت عندي متقدم  بستة ساعات عن وقت الدول العربية.

بالتوفيق

الكل.rar

سبب الخطاء هو وجود الجدول Vac مسبقا هل هذا صحيح؟

اذا اليك هذا التغير في الكود.

او ارفق ملفك للنظر اين المشكلة.

Dim strSQL As String
Dim empId As Long
Dim db As DAO.Database
Dim rsVacation As DAO.Recordset
Dim qdf As DAO.QueryDef

empId = [TempVars]![EmpIdTemp]

strSQL = "SELECT * FROM tblVacation " & _
         "WHERE (((tblVacation.emp_code) = " & empId & " AND (tblVacation.VacationLife) = 'سارية')) " & _
         "ORDER BY vacationstartdate ASC;"

Set db = CurrentDb
Set qdf = db.CreateQueryDef("", strSQL)
Set rsVacation = qdf.OpenRecordset()

rsVacation.Close
Set rsVacation = Nothing
Set qdf = Nothing
Set db = Nothing

جرب هذا 

Dim strSQL As String
Dim empId As Long 

empId = [TempVars]![EmpIdTemp]

strSQL = "CREATE TABLE vac AS " & _
         "SELECT * FROM tblVacation " & _
         "WHERE (((tblVacation.emp_code) = " & empId & " AND (tblVacation.VacationLife) = 'سارية')) " & _
         "ORDER BY vacationstartdate ASC;"

السلام عليكم

حسب ما فهمت جرب 

AVGS24: Round(Avg(IIf([S24] <> 6, [S24], Null)), 0)

ماشاءالله قمة الابداع .

السلام عليكم

لكم جزيل الشكر اخواني الكرام  @شايب @عبدالجيد @د.كاف يار على تجربتكم للملف. 

الاخ @seddiki_adz ابحث بالمنتدى عن اعدادات اللغة في المنتدى وستجد الكثير من المواضيع وكيفية حل المشكلة لديك.

بالتوفيق

اخي الكريم بارك الله فيك ما علاقة ملف الاكسل في موضوعنا هل الملف الاصلي لديك فيه اكواد غير هذا الملف الذي ارفقته هنا لان الملف الذي عملت عليه يعمل بكفاءة والاخ @شايب جرب الملف وعمل ايضا بدون مشاكل. الملف الاخير غيرت فيه بعض المسميات وا انا اسف ربما يستطيع احد الاخوة مساعدتك .

تحياتي

اخي الكريم

يبدو لي ان المشكلة في اللغة حاول ان تغير من الفرنسية الى الإنكليزية من خلال إعدادات اللغة في الويندوز هذا أولا

ثانيا افتح ملف جديد واستورد الجدول والفورم والتقارير جرب وأعلمنا بالنتيجة.

أخي الكريم

تفضل التعديل هل هو المطلوب ؟

الملف تم تجربته على الاوفيس 2021 وحاليا لا املك غير هذه النسخة .

2 ساعات مضت, شايب said:

من تجربة سريعة تعمل ولا تظهر رسالة خطأ

مع ذلك

لوجعلت الفلترة تتم بعد اختيار الحقول الثلاثة ولكن هي فكرة فقط

نعم  أستاذي شايب كلامك صجيج ولكن هذا ما فهمته من طلب الاخ السائل. حاليا الوقت عندي متأخر  الساعة23:30 مساءا غدا سوف اغير الكود ان شاءالله.

bdd2.accdb

الرجاء من الاخوة الكرام تجربة الملف الاول او الثاني وهل تعمل التصفية حسب طلب الاخ السائل في اول مشاركة له

لان الملفات تعمل بشكل صجيج عندي بينما الاخ السائل لديه مشكلة في فتح الملف. ولم يخبرني ما هي نص الرسالة لانها  بالفرنسي.

وهنا تم تغير الطلب الى

17 دقائق مضت, seddiki_adz said:

لمطلوب

1) هو نافذة الادخال تسجيل البيانات

2) قائمة للطلبةحسب المستوى الفوج والاستاد

كما هو موضح في الملف

هل ممكن ترجمة نص الرسالة للعربي 

جرب هذا الملف الان

bdd2003.mdb

ما هي نسخة الاوفيس لديك هل هي 2016 او اقدم؟

السلام عليكم

تفضل أخي الكريم حسب ما فهمت من طلبك

لقد غيرت اسماء الحقول من العربي الى الانكيزي وذلك لصعوبة عمل الاكواد باللغة العربية.

Option Compare Database
Option Explicit
Private Sub cboName_AfterUpdate()
    Dim rs As Object
    Set rs = Me.Recordset.Clone
    rs.FindFirst "[Name_Surname] = '" & Me![cboName] & "'"
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
    cboLevel = ""
    cboSubject = ""
    cboRegiment = ""
End Sub

Private Sub cboLevel_AfterUpdate()
    Dim rs As Object
    Set rs = Me.Recordset.Clone
    rs.FindFirst "[Level] = '" & Me![cboLevel] & "'"
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
    cboName = ""
    cboSubject = ""
    cboRegiment = ""
End Sub

Private Sub cboRegiment_AfterUpdate()
 Dim rs As Object
    Set rs = Me.Recordset.Clone
    rs.FindFirst "[Regiment] = '" & Me![cboRegiment] & "'"
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
    cboName = ""
    cboSubject = ""
    cboLevel = ""
End Sub

Private Sub cboSubject_AfterUpdate()
   Dim rs As Object
    Set rs = Me.Recordset.Clone
    rs.FindFirst "[Subject] = '" & Me![cboSubject] & "'"
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
    cboName = ""
    cboRegiment = ""
    cboLevel = ""
End Sub

وهذا الملف بعد التعديل

بالتوفيق

bdd2.accdb

السلام عليكم

اليك التعديل هل هو المطلوب ؟

S&M_22.rar

اخي الكريم  طلبك الاول كان هذا

19 ساعات مضت, moho58 said:

نعم اريد  اظهار جميع اسماء المؤطرين الموجودين في الجدول tbl_Teachers

ثم طلبت

16 ساعات مضت, moho58 said:

أنا أريد أن  أختار الوحدة فقط   تم أختار المؤطر

ثم  غيرت طلبك الى هذا

16 ساعات مضت, moho58 said:

أخي عند اختيار  grade  من النموذج  يجب أت تكون subject  موافقة لها مثل ما هو موجود  في جدول  tbl_Teachers

كما هو موضح  في الجدول

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

لقد عملت لك مربعين تحرير وسرد الاول Grade والثانني Subject  انظر للطريقة المتبعة وحاول ان تكمل . 

إذا كان هذا طلبك كما قلت لك عليك  بتغير اشياء كثيره .

بالتوفيق

t-times.accdb

حياك الله اخوي

تفضل التعديل

t-times.accdb

الشكر لله عز وجل

تفضل اخي العزيز

فقط عدل على باقي الخانات بنفس الطريقة

بالتوفيق

t-times.accdb

هل هذا هو المطلوب؟

انطر الى اول خانه فقط .

t-times.accdb

في 3‏/7‏/2023 at 08:13, moho58 said:

* أما في المؤطر فتظهر قائمة بأسماء جميع    TeacherName   الموجودة في الجدول TeacherName   وأنا أختار المؤطر  

اخي الكريم

هل  تقصد إظهار اسم المؤطر فقط بدون اسم المادة ؟  لانني بصراحة لم افهم المطلوب بالضبط .

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

تفضل اخي الكريم 

عملت الكود حسب الحقول الموجودة في الجدول إذا كان هناك حقل فارغ سيتم حذف السجل نهائيا. جرب ووافنا بالنتيجة

بالتوفيق

Private Sub Form_AfterUpdate()

    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim Field1, Field2, Field3 As Variant
    
        strSQL = "SELECT * FROM aaa"
        Set rs = CurrentDb.OpenRecordset(strSQL)
                      rs.MoveFirst
                      Do Until rs.EOF
         Field1 = rs.Fields("Nam").Value
         Field2 = rs.Fields("Home").Value
         Field3 = rs.Fields("dats").Value

        If IsNull(Field1) Or Field1 = "" Or IsNull(Field2) Or Field2 = "" Or IsNull(Field3) Or Field3 = "" Then
        
                      MsgBox "توجد حقول غير مكتملة ...  سوف يتم حذف السجل كليا", vbExclamation, "تنبيه"
                      rs.Delete
                      If Not rs.EOF Then
                      rs.MoveNext
        End If
                      Else
                      rs.MoveNext
        End If
        
        Loop
                      rs.Close
                      Set rs = Nothing
                      DoCmd.Requery
    
                      MsgBox " . تمت عملية حذف الحقول الفارغة ", vbInformation, "تمت العملية بنجاح"
End Sub

وهذا الملف بعد التعديل

program.accdb

الشكر لله عز وجل اخي العزيز.

بالتوفيق 

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

تفضل اخي الكريم

Private Sub cmdSearch_Click()
Dim strSearch As String
Static XC
Dim rs As Object
Set rs = Me.RecordsetClone
Me.أمر26.Visible = False
Me.أمر27.Visible = False
Me.أمر29.Visible = False
Me.أمر30.Visible = False
Me.أمر32.Visible = False
Me.أمر35.Visible = False

   If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then
          MsgBox "رجاء ادخل اسم للبحث عنه", vbOKOnly, "خطأ في البحث"
          Me![txtSearch].SetFocus
   Exit Sub
   End If
   strSearch = Me![txtSearch]
  
   With rs
  .FindNext "[emp_nam] like '*" & strSearch & "*'"
   
   If Not .emp_nam Like "*" & strSearch & "*" Then
          MsgBox "لا يوجد سجل بهذا الإسم :  " & strSearch, vbCritical, "غير موجود"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus

   ElseIf .NoMatch Then
          MsgBox "آخر سجل في البحث عن :  " & strSearch, vbExclamation, "آخر سجل"
          Me.cmdSearch.Caption = "بحث"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus
          Me.cmdSearch.ForeColor = RGB(0, 0, 255)
Me.أمر26.Visible = True
Me.أمر27.Visible = True
Me.أمر29.Visible = True
Me.أمر30.Visible = True
Me.أمر32.Visible = True
Me.أمر35.Visible = True

  DoCmd.GoToRecord , , acFirst
  rs.MoveFirst
  XC = 0
   Else
XC = XC + 1
   Me.Bookmark = .Bookmark
          If XC = 1 Then MsgBox "تم ايجاد اسم :  " & strSearch, vbInformation, "مبروك"
          Me.cmdSearch.Caption = "اكمال البحث"
          Me.cmdSearch.ForeColor = RGB(255, 0, 0)
   End If
   End With

rs.Close
Set rs = Nothing


End Sub

وهذا الملف بعد التعديل للعلم انا استخدم الاوفيس 2021 اذا لم يفتح معك الملف فقط انسخ الكود اعلاه وضعه تحت زر البحث ويجب عليك تغير مسميات الزر ونص البحث كما هو في الكود.

تحياتي 

Database2023.accdb