كل الانشطه

وعليكم السلام ورحمة الله تعالى وبركاته استاذى الجليل و معلمى القدير و والدى الحبيب الكود التالى فى وحده نمطية عامة Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function SetTimer Lib "user32" _ (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _ ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr Private Declare PtrSafe Function KillTimer Lib "user32" _ (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long #Else Private Declare Function SetTimer Lib "user32" _ (ByVal hWnd As Long, ByVal nIDEvent As Long, _ ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" _ (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long #End If Private lngTimerID As LongPtr Private frmTargetClock As Form Public Sub StartSystemClock(frm As Form) Set frmTargetClock = frm lngTimerID = SetTimer(0, 0, 1000, AddressOf TimerProc) End Sub Public Sub StopSystemClock() If lngTimerID <> 0 Then KillTimer 0, lngTimerID lngTimerID = 0 End If End Sub Private Sub TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long) If Not frmTargetClock Is Nothing Then frmTargetClock!lblClock.Caption = Format(Now, "hh:nn:ss AM/PM") Else StopSystemClock End If End Sub الاحدات فى النموذج Option Compare Database Option Explicit Private Sub Form_Load() Call StartSystemClock(Me) End Sub Private Sub Form_Unload(Cancel As Integer) Call StopSystemClock End Sub المرفق Clock Without Timer Event.accdb

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

السلام عليكم ياكرام لدي مربع اختيار يضيف التاريخ والوقت عند اختيار ولكن للاسف يتغير عن الاختيار الاخر يتغير الوقت والتاريخ كل مرة وانا اريدة ثابت عندما اقوم بختيارة ولا يتاثر عن الاختيار وكذالك جربت طريقة ثانية ولم تنجح مرفق صور المعادلة الاخر امل المساعدة ولكم جزيل الشكر مرفق الملف مربع اختيار يضيف التاريخ والوقت عند الاختيار.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 من استفسارك هو الارجح