كل الانشطه

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

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

السلام عليكم المطلوب كما في العنوان Database1.accdb

تمام الله ينور على حضرتك ويجازيك خير ما فعلت ممكن تشرحلى عملتها ازاي ويبقى كتر خيرك وشكرا

استخدم التنسيق الشرطي .... افضل .... انظر

وعليكم السلام ورحمة الله و بركاته Sub PrintOrExportPDF_CustomRanges() Dim ws As Worksheet Dim rngAddress As String Dim sheetNames As Variant Dim printableSheetNames() As String Dim i As Integer, count As Integer Dim printChoice As VbMsgBoxResult Dim savePath As String Dim fileName As String ' أسماء الأوراق (عدّل حسب أوراقك) sheetNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4") count = 0 ' سؤال المستخدم: طباعة أم PDF؟ printChoice = MsgBox("هل ترغب في طباعة الأوراق؟" & vbCrLf & "اضغط 'نعم' للطباعة، 'لا' لحفظ كـ PDF.", vbYesNoCancel + vbQuestion, "اختيار نوع الإخراج") If printChoice = vbCancel Then MsgBox "تم إلغاء العملية.", vbExclamation Exit Sub End If Application.ScreenUpdating = False ' تحديد النطاقات For i = LBound(sheetNames) To UBound(sheetNames) Set ws = ThisWorkbook.Sheets(sheetNames(i)) rngAddress = InputBox("أدخل النطاق المطلوب طباعته من الورقة: " & sheetNames(i), "تحديد نطاق الطباعة") If rngAddress <> "" Then On Error Resume Next ws.PageSetup.PrintArea = rngAddress If Err.Number = 0 Then count = count + 1 ReDim Preserve printableSheetNames(1 To count) printableSheetNames(count) = ws.Name End If On Error GoTo 0 Else MsgBox "تم تخطي الورقة: " & sheetNames(i), vbInformation End If Next i ' تنفيذ العملية حسب الاختيار If count > 0 Then If printChoice = vbYes Then ' ? طباعة مباشرة Sheets(printableSheetNames).PrintOut MsgBox "تمت طباعة الأوراق المحددة بنجاح.", vbInformation ElseIf printChoice = vbNo Then ' ? تصدير كـ PDF (بمصنف مؤقت) With Application.FileDialog(msoFileDialogFolderPicker) .Title = "اختر المجلد لحفظ ملف PDF" If .Show <> -1 Then MsgBox "لم يتم اختيار مجلد.", vbExclamation Exit Sub End If savePath = .SelectedItems(1) End With fileName = InputBox("أدخل اسم ملف PDF بدون .pdf", "اسم الملف") If fileName = "" Then MsgBox "لم يتم إدخال اسم الملف.", vbExclamation Exit Sub End If ' إنشاء مصنف مؤقت Dim tempBook As Workbook Set tempBook = Workbooks.Add ' نسخ الأوراق للمصنف المؤقت For i = 1 To count ThisWorkbook.Sheets(printableSheetNames(i)).Copy After:=tempBook.Sheets(tempBook.Sheets.count) Next i ' حذف الورقة الافتراضية الفارغة Application.DisplayAlerts = False Do While tempBook.Sheets.count > count tempBook.Sheets(1).Delete Loop Application.DisplayAlerts = True ' حفظ كـ PDF tempBook.ExportAsFixedFormat _ Type:=xlTypePDF, _ fileName:=savePath & "\" & fileName & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=True ' إغلاق المصنف المؤقت بدون حفظ tempBook.Close SaveChanges:=False MsgBox "تم حفظ ملف PDF بنجاح.", vbInformation End If Else MsgBox "لم يتم تحديد أي ورقة للطباعة أو التصدير.", vbExclamation End If Application.ScreenUpdating = True End Sub

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

Up up upاين الردود ؟؟؟؟

عمر ضاحى بارك الله فيك اخي الكريم ولكن بعد ربط وتظبيط الكود لم تاتي لي النتيجه تم التعديل على هذا المرفق ولم تنجح معي ABDatabase.rar

السلام عليكم جرب هذا الحل المعدات v3.xlsx

هذه فكرة بسيطة .. Foksh.accdb

السلام عليكم .. ممكن كود او معادلة يقوم بإظهار نتائج الغياب اليومي والشهري للموظفين .. الشرح داخل المصنف جزاكم الله خيرا موقف غياب موظفين.xlsm

مداخله بعد اذن الاستاذ فادي ^_^ ما تم هو اضافة هذه الجملة قبل جملة الاستعلام لكل قائمة SELECT "<الكل>" AS Odb_NoAcc FROM Table_ALLcauct UNION لتصبح هكذا (كمثال) SELECT "<الكل>" AS Odb_NoAcc FROM Table_ALLcauct UNION SELECT Odb_NoAcc FROM Table_ALLcauct GROUP BY Odb_NoAcc; اتمنا يكون هذا ما تريد ABDatabase.rar

السلام عليكم المطلوب كود طباعة كود اطبع بيه الأربع صفحات او اكثر مع بعض مرة واحدة ولكن طباعة النطاق اللى انا احدده والنطاق ده هيكون مختلف في كل صفحة انا مش عايز اطبع اوراق العمل كلها ولا الصفحة كاملة مناطق مختلفة من اكثر من صفطباعة اكثر من صفحة.xlsbحة بكود واحد فقط واخيرا اتقدم بالشكر لحضراتكم لما تقدمونه لا عضاء المنتدى من معلومات قيمة وحلول سريعه ولما تبذلونه من جهد ملحوظ جعله الله فى ميزان حسانات من نفع وانتفع بعلمه الناس طباعة اكثر من صفحة.xlsb

Up

Foksh شكرا لك اخي الكريم على مرورك الكريم المقصود بكلمه (الكل) يوجد احيانا اختيار محدد ويمكن اختيار الكل فا اريد اتاحه كافة الاختيارات في الاستعلامات شكرا لك اخي الكريم

ممكن اخواني الاعزاء عندة برنامج قائمة منسدلة يكون الصلاحيات على نفس القائمة اختار منها يوفي بالغرض يعطيني او تعديل على المرفق test.accdb

طيب تمام ، جرب هذه الفكرة السريعة ، وباعتقادي قد تجد أفكار أفضل 100% من الأخوة والأساتذة والمعلمين هنا .. الجمعية 29.zip

وعليكم السلام ورحمة الله وبركاته ,, من باب السؤال أخي الفاضل ، ماذا بعد أن يتم إضافة كلمة (الكل) الى الكومبوبوكسات ؟؟؟؟؟؟؟؟؟؟؟؟؟ اعلم أن من وراء هذا الطلب سيكون طلب آخر ، لذا آتنا به .

السلام عليكم اساتذتي الكرام بعد التحيه برجاء مساعدتي في انشاء كلمة (الكل) داخل كل كومبو بوكس عند الاستعلام مرفق البيان ABDatabase.rar

أخي الكريم السلام عليكم ورحمة الله وبركاته ,, أولاً أهلا وسهلاً بك معنا في هذا الصرح الكبير .. ونتمنى أن تجد ما تبحث عنه دائماً من حلول وإجابات لإستفساراتك .. لاختيارك الإجابة التي تريدها والتي حققت لك طلبك بشكل كامل ، انظر الفيديو التالي ، للإستفادة منه كي لا تقع في نفس المشكلة لاحقاً .. وشكراً لك ، وأهلاً بك مرة أخرى

لا لا حضرتك اعمل اي عدد حتى ولو 5 اعمده فقط وانا هنسق ده وشكرا

بارك الله فيك اخونا منتصر الانسي على الاهتمام و لكن المشكلة كما موضحة بالفيديو أنه عند اختيار منطفة تتساوى فيها قيمة العلاوة لا تتغير المنطقة المطلوبة بل تبقى المنطقة الاولي في ترتيب الجدول Screen Recording 2025-06-28 161900.zip

الجدول الموجود في الملف حقيقي بالتواريخ واليوم والمادة اريد تفريغ الملاحظين في كشف الملاحظة لكل مادة باليوم والتاريخ واضافة الاحتياطي من الملاحظين الفارغين من الملاحظة بالاحتياطي واستعمال زر Spinner لتغير اليوم والتاريخ والمادة حسب الجدول وعند الطباعة يتم طباعة جميع الايام مرة واحدة رقم 2 من استفسارك هو الارجح

طيب جرب هذا الكود بدل الموجود تحت الزر عندك .... On Error GoTo ErrorHandler Dim db As DAO.Database Dim rsEmp As DAO.Recordset Dim rsHol As DAO.Recordset Dim strSQL As String Dim intCount As Integer Dim blnExists As Boolean ' التحقق من وجود تاريخ في مربع النص If IsNull(Me.Controls("نص11").Value) Or Me.Controls("نص11").Value = "" Then MsgBox "الرجاء إدخال تاريخ في مربع النص نص11", vbExclamation, "تاريخ مفقود" Exit Sub End If ' التحقق من أن القيمة تاريخ صحيح If Not IsDate(Me.Controls("نص11").Value) Then MsgBox "القيمة في مربع النص ليست تاريخاً صحيحاً", vbExclamation, "تاريخ غير صالح" Exit Sub End If Me.Recalc ' فتح اتصال بقاعدة البيانات Set db = CurrentDb() ' إنشاء سجل مجموعة لجدول الموظفين (emp) حيث att = "غياب" strSQL = " SELECT emp.[no], emp.Att " & _ " FROM emp " & _ " WHERE (((emp.Att)="" غياب""));" Set rsEmp = db.OpenRecordset(strSQL) ' التحقق من وجود سجلات If rsEmp.EOF And rsEmp.BOF Then MsgBox "لا توجد سجلات غياب في جدول الموظفين", vbInformation, "لا توجد بيانات" GoTo CleanUp End If ' فتح جدول hol للكتابة Set rsHol = db.OpenRecordset("hol") ' بدء عملية الإدراج intCount = 0 Do Until rsEmp.EOF ' التحقق من عدم وجود سجل مكرر blnExists = DCount("[no]", "[hol]", "[absdate] =#" & [Forms]![تسجيل الحضور والغياب]![نص11] & "# And [no] =" & rsEmp!no & " ") If Not blnExists Then On Error Resume Next ' لتجنب أخطاء الإدراج rsHol.AddNew rsHol!no.Value = rsEmp!no.Value rsHol!absDate.Value = [Forms]![تسجيل الحضور والغياب]![نص11] rsHol.Update If Err.Number = 0 Then intCount = intCount + 1 Else MsgBox "خطأ في إدراج سجل للموظف رقم " & rsEmp!no & ": " & Err.Description, vbExclamation Err.Clear End If On Error GoTo ErrorHandler Else MsgBox "تم تجاهل الموظف رقم " & rsEmp!no & " لأنه مسجل غياب بالفعل في هذا التاريخ", vbExclamation, "سجل مكرر" End If rsEmp.MoveNext Loop MsgBox "تم إدراج " & intCount & " سجل غياب بنجاح", vbInformation, "تمت العملية" CleanUp: On Error Resume Next If Not rsEmp Is Nothing Then rsEmp.Close Set rsEmp = Nothing End If If Not rsHol Is Nothing Then rsHol.Close Set rsHol = Nothing End If Set db = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description & " (السطر: " & Erl & ")", vbCritical, "خطأ" Resume CleanUp