سامي الحداد

تفضل اخي الكريم هذا الكود لتحويل التقرير إلى صيغة pdf 

Private Sub أمر65_Click()

    Dim varItem As Variant
    Dim myWhere As String
    Dim Criteria As String
    Dim ReportName As String
    
    ReportName = "rap_liste_stagiere_grade_groupe1"
    
    Criteria = varItem
    myWhere = ""
    
    ' Loop through the selected items in the ListBox
        For Each varItem In Me.lst_XX.ItemsSelected
    ' Add each selected item to the string
        myWhere = myWhere & "'" & Me.lst_XX.ItemData(varItem) & "', "
    Next varItem
    
    ' Remove the trailing comma and space from the string
        myWhere = Left(myWhere, Len(myWhere) - 2)
    
    DoCmd.OpenReport "rap_liste_stagiere_grade_groupe1", acViewPreview, , "[grade] in (" & myWhere & ")"
    DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF
    DoCmd.Close acReport, ReportName, acSaveNo
    
End Sub

نفس الكود تستطيع ان تستخدمه في طباعة التقرير مع تغير بسيط في هذا السطر  DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF

بالتوفيق

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

 On Error Resume Next
    
    ' تعيين القيم المطلوبة لعرض النموذج
    Me.WindowWidth = 1920
    
    ' تعيين القيم المطلوبة لارتفاع المساحة الداخلية للنموذج
    Me.WindowHeight = 1080
    
    ' توسيط النموذج على الشاشة
    Me.Left = (Application.Width - Me.Width) / 2
    Me.Top = (Application.Height - Me.Height) / 2
    
    On Error GoTo 0

بالتوفيق

السلام عليكم

عندك أخطاء في كتابة الكود انظر للتعديل 

If MsgBox("هل تريد الحفظ", vbYesNo, "خطابات الضمان") = vbYes Then
    Application.SetOption "Confirm Record Changes", False

    If Not IsNull(BA3) And Not IsNull(BA17) And Not IsNull(BA22) And Not IsNull(BA21) And BA5 > N2 And BA1 = "زيادة" Then
        N3 = BA5 - N2
        N4 = N3 + N2
        BA19 = N4
        Forms![ShowNew1]![BA19] = N4
        Forms![ShowNew1]![N2] = N4
        DoCmd.RunCommand acCmdSaveRecord
        Application.SetOption "Confirm Record Changes", True

    ElseIf Not IsNull(BA3) And Not IsNull(BA17) And Not IsNull(BA22) And Not IsNull(BA21) And BA5 < N2 And BA1 = "تخفيض" Then
        N3 = N2 - BA5
        N4 = N2 - N3
        BA19 = N4
        Forms![ShowNew1]![BA19] = N4
        Forms![ShowNew1]![N2] = N4
        DoCmd.RunCommand acCmdSaveRecord
        Application.SetOption "Confirm Record Changes", True

    ElseIf Not IsNull(BA3) And Not IsNull(BA17) And Not IsNull(BA22) And Not IsNull(BA21) And BA5 = N2 And BA1 = "رد" Then
        N3 = BA5 - N2
        BA19 = N3
        Forms![ShowNew1]![BA19] = N3
        Forms![ShowNew1]![N2] = N3
        DoCmd.RunCommand acCmdSaveRecord
        Application.SetOption "Confirm Record Changes", True
        MsgBox "تم الحفظ بنجاح"
    ElseIf IsNull(BA1) Or IsNull(BA3) Or IsNull(BA17) Or IsNull(BA22) Or IsNull(BA21) Then
        MsgBox "أكمل البيانات الاساسية قالناقصة ايمة التسوية - رقم الخطاب - تاريخ الاصدار - تاريخ السريان"
    End If
End If

إذا لم يعمل  معك التعديل ارفق مثالك هنا حتى نستطيع مساعدتك 

بالتوفيق

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

أخي الكريم لو بحثت قليلا لوجدت الكثير من المواضيع بخصوص طلبك  

مثلا هذا الموضوع للاستاذ موسى جزاه الله خيرا .

ولو ارفقت ملفك لوجدت تفاعل كبير من اخوانك. 

تحياتي لك وبالتوفيق

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

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

عمل استعلام  لمعرفة المكرر

وهذا ملفك بعد الاضافة

بالتوفيق

Database2.accdb

في 22‏/8‏/2023 at 06:14, حسان12 said:

لاسف الاستعلام المرسل الى الاخ الكريم لا يظهر الطريقة او الكود المطبق 

هذا هو الكود المطبق 

اخي الكريم @حسان12 لو ارفقت ملفك والمشكلة في موضوع مستقل لوجدت تفاعلا من اخوانك 

بالتوفيق

في 13‏/8‏/2023 at 00:28, imadimadimad said:

قي اذا امكن مساعدتي في النقطه الثالثه والرابعه

منع الكتابه في المؤهل العلمي للموظف قبل ادخال اسم الموظف

تفضل اخي الكريم هذا الكود بالنسبة للنقطة الثالثة.

Private Sub المؤهل_العلمي_AfterUpdate()

    Dim MainForm As Form
    Set MainForm = Forms("الاسم")
    
    If Nz(MainForm!الاسم.Value, "") = "" Then
        MsgBox "يرجى ملىء حقل الاسم في النموذج الرئيسي قبل إضافة قيمة في مربع المؤهل العلمي", vbInformation, "تنبيه"
        Me.المؤهل_العلمي.Undo
        MainForm!الاسم.SetFocus
    End If
End Sub

اما  بالنسبة للنقطة الرابعة الاستعلام رقم 1 موجود لديك وهو يلبي طلبك ولديك ايضا الفورم ومصدره هو الاستعلام رقم1 فقط ضعه في القورم الرئيسي وسيؤدي المطلوب

بالتوفيق

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

بالاصافة لما تفضل به الاستاذ @اكرم العريقي 

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

بالتوفيق  

قاعدة البيانات مع محرك البحث-2.accdb

أخي واستاذي الحبيب ابو جودي الورد

نحن تلاميذكم وسنبقى تلاميذ هذا المنتدى المبارك بفضل من الله ومنكم استاذتي الكرام

يشهد الله إنني تعلمت الكثير منك ومن باقي الأستاذة جميعا أنتم من أنار لنا هذا الطريق بفضل الله وعلمكم الذي لم تبخلوا به علينا.

دمتم في رعاية الله وحفظه. 

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

استاذي الكريم @ابو جودي

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

Get Value Combo Box Multi Select.accdb

تفضل اخي الكريم جرب الان هذا التعديل

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

وهذا تعديل اخر مثل ما طلبت في الصورة 

بالتوفيق

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

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

الكنترول المدرسى.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) قائمة للطلبةحسب المستوى الفوج والاستاد

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

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