نجوم المشاركات

السلام عليكم ورحمة الله وبركاته الأخوة الكرام أسعد الله مسائكم بالخير واليمن والبركات نستخدم كثير الأمر Debug.print أو Msgbox لطباعة نتائج الأكواد والخطاء أثناء البرمجة وبعد المراجعة والإنتهاء من الكود تريد تعطيل هذه الأوامر ولذلك ولله الحمد والفضل فكرت في هذه الأداة البسيطة (الكود بالأسفل) طريقة الإستخدام : Call LogMessage "Test message", llInfo, True, True message = الرسالة او الناتج المراد طباعته level = أهمية الرسالة وقد تم تعريف 4 مستويات يمكنك الإضافة حسب إحتياجك Public Enum LogLevel llInfo = 0 llWarning = 1 llError = 2 llCritical = 3 End Enum useDebug = هل تريد طباعة النتيجة في الـ Immediate Window showMsgBox = هل تريد ظهور رسالة بالناتج وهذا يمكننا من إضافة معرف ثابت علي مستوي الوظيفة او المديول وإستخدامة للإيقاف والتفعيل Private Const Debug_Mode_ON As Boolean = True Private Const MsgBox_Mode_ON As Boolean = False كما يمكن لاحقاً إضافة خاصية لـ TempMsgBox وهي لإظهار الرسال بشكل مؤقت أعتقد ان الكود موجود بالمنتدي والنسخة التي أستخدمها بها ميزة لإختيار الزر الإفتراضي عند إنتهاء الوقت المحدد للرسالة (سأشاركها قريباً إن شاء الله) '----------------------------------------------------------------------------------------- ' Module : AWS_LOG_Message ' Author : Original: Ahmos - The Last Egyptian King ' Enhanced: Ahmos - The Last Egyptian King ' Email : Phoronex@yahoo.com ' Purpose : Provide flexible logging functionality with various log levels and options ' Copyright : © 2024 Ahmos. Released under Attribution 4.0 International ' (CC BY 4.0) - https://creativecommons.org/licenses/by/4.0/ ' ' Usage: ' ~~~~~~ ' LogMessage "Test message", llInfo, True, True ' Log a message with debug and message box ' ' Revision History: ' Rev Date(yyyy-mm-dd) Description ' ---------------------------------------------------------------------------------------- ' 1 2024-10-30 Initial version '----------------------------------------------------------------------------------------- ' Functions: ' ~~~~~~~~~~ ' LogMessage : Flexible logging with debug and message box options ' ' ' Notes: ' ~~~~~~ ' - Logging function supports different levels (Info, Warning, Error, Critical) ' - Options for debug output and message box display '----------------------------------------------------------------------------------------- ' **-----**_______________{]___________________________________________________________ ' {&&&&&&&#%%&#%&%&%&%&%#%&|]__________________________The Last Egyptian King___________\ ' {] '----------------------------------------------------------------------------------------- Public Enum LogLevel llInfo = 0 llWarning = 1 llError = 2 llCritical = 3 End Enum Public Sub LogMessage(ByVal message As String, _ Optional ByVal level As LogLevel = llInfo, _ Optional ByVal useDebug As Boolean = False, _ Optional ByVal showMsgBox As Boolean = False) Dim prefix As String Dim msgBoxStyle As VbMsgBoxStyle Dim msgBoxTitle As String Dim fullMessage As String Select Case level Case llInfo prefix = "INFO" msgBoxStyle = vbInformation msgBoxTitle = "Information" Case llWarning prefix = "WARNING" msgBoxStyle = vbExclamation msgBoxTitle = "Warning" Case llError prefix = "ERROR" msgBoxStyle = vbCritical msgBoxTitle = "Error" Case llCritical prefix = "CRITICAL" msgBoxStyle = vbCritical msgBoxTitle = "Critical Error" End Select fullMessage = "[" & prefix & "] " & ": " & message If useDebug Then Debug.Print fullMessage End If If showMsgBox Then MsgBox fullMessage, msgBoxStyle, msgBoxTitle End If End Sub

السلام عليكم 🙂 رجاء الرجوع الى النسخة الاولى من هذا الموضوع لفهم تفاصيل الكود . عرضت عليكم جميع التفاصيل في عمل حدث الـ Data Macro ، فكان على المبرمج ان يكتب جميع خطوات الكود لكل حقل ولكل حدث ، يدويا !! وهنا اعطيكم طريقة طريقة عمله برمجيا (يعني المبرمج ما عنده عذر من الان ان لا يستخدم هذه الاداة في برامجه 🙂 ). هذه واجهة وكائنات البرنامج: . 9. نقوم بالنقر على الزر رقم 9 مرة واحدة فقط ، فيقوم بنسخ الجدول جدول tbl_x_AuditTrail فارغ ، والوحدة النمطية mod_UserName_PcName ، الى قاعدة البيانات التي تم اختيارها في رقم 3 ، 1. جدول tbl_x_AuditTrail فارغ ، وسيتم عمل نسخة منه ومن الوحدة النمطية mod_UserName_PcName عند النقر على الزر رقم 9 ، الى قاعدة البيانات التي تم اختيارها في رقم 3 ، 2. يجب اختيار قاعدة البيانات التي تريد عمل احداث الجداول عن طريق الـ Data Macro فيها ، وسيتم ظهور اسم قاعدة البيانات في الرقم 3 ، وفي نفس الوقت سيتم ظهور اسماء جداولها في الرقم 4 ، 4. اختار الجدول الذي تريد عمل الاحداث عليه ، ومنها ستظهر اسماء حقوله في الرقم 5 ، 5. تختار اسماء الحقول التي تريد ان تتابع متغيراتها (وهو اساس هذا البرنامج) ، وتستطيع اختيار جميع الحقول لهذا الحدث بالنقر على الزر 6 : 5.1 لتسجيل وحفظ متغير الحقل عند اضافة سجل جديد (الحاق سجل جديد) ، 5.2 لتسجيل وحفظ متغير الحقل عند عمل تغيير على قيمة الحقل (بعد تحديث الحقل) ، 5.3 لتسجيل وحفظ متغير الحقل عند حذف السجل ، 7. يجب اختيار حقل المفتاح الاساسي في الجدول ، 8. عند الانتهاء من الاختيارات ، ننقر على الزر رقم 8 ، فيقوم بعمل الـ Data Macro لجميع الحقول في الجدول الذي تم اختياره ، وستاتيك رسالة تؤكد انتهاء العمل. وللعمل على حقول جدول آخر ، ابدأ من الرقم 4 اعلاه مرة اخرى. هنا سأعطي مثال عن طريقة العمل ، والنتائج: هذه قاعدة البيانات التي ساعمل عليها ، ونرى انه لا يوجد بها الجدول tbl_x_AuditTrail فارغ ، ولا الوحدة النمطية mod_UserName_PcName ، ولا توجد اي احداث في المربع الاحمر : . خطوات العمل: . والنتيجة في قاعدة البيانات الاخرى: . والان لنرى عندما نعمل اي تغيير في المتغيرات: . هنا نرى ان الاحداث الثلاثة موجودة في هذا الجدول ، وطبعا في الجدول الآخر كذلك : . وهنا نقارن النتائج . جعفر Make_AuditTrail_XML_02.zip

السلام عليكم ورحمة الله وبركاته اساتذتي الافاضل عندي مثال مرفق واطلب منكم عمل استعلام بشروط ثلاثه ان يظهر لي الاسماء الي تاريخ الوارد لهم شهر (4) وتاريخ الاجراء شهر (4) مع بيان الاجراء الذي تم. مثال على ذلك الاسم الجنسيه تاريخ الوارد تاريخ الاجراء الاجراء صالح سعودي 1/4/2024 10/4/2024 سدد محمد اماراتي 21/4/2024 31/4/2024 انتهى فيصل قطري 5/4/2024 20/6/2024 فاعل خير حمد قطري 13/4/2024 15/7/2024 انتهى حمد قطري 13/4/2024 المطلوب الاستعلام يظهر لي صالح ومحمد فقط لانهم وصلوا شهر 4 وخلصوا شهر 4 وكذلك خانة الاجراء فيها كلام وجزاكم الله كل خير مثال.rar

وهنا اعطيك حل للما سبق ذكره strSQL = "INSERT INTO kanory ( a, b, c, d ) " & vbCrLf & _ "SELECT Bdgi.Obsérvation, Bdgi.PDG_Pr, ""02- المداخيل ( الموارد)"" AS Expr1, ""1"" AS Expr2 FROM Bdgi " & vbCrLf & _ "WHERE (((Format([PDG_Date],""dd-mm-yyyy"")) Between [Forms]![FrmMasarif_Trémestre]![Date_First] And [Forms]![FrmMasarif_Trémestre]![Date_End]));" ده بس انتبه ان لا يستخدم المتغير فى شئ اخر غير التاريخ ولازم تعلن عنه وغير كده انا شايف ان المتغيرات هنا ما لها لزمه معاك

اتعبتك معي استاذي العزيز الم تلاحظ ان البحث كان ينفذ عادي قبل الكود الاخير لجملة الـ strSQL 'FormatDate d1 = Format(Me.Date_First, "MM/dd/yyyy") d2 = Format(Me.Date_End, "MM/dd/yyyy")

اتفضلى No.of record.rar

السلام عليكم ورحمة الله وبركاته جزاك الله خيراً وبارك فيك أخي عبد الله، هذا هو المطلوب بارك الله فيك و أحسن إليك، شكراً شكراً شكراً شكراً شكراً جزيلا

وعليكم السلام ورحمة الله وبركاته تم عمل كود بدل معادلات الصفيف والترتيب الكود ينظر الى السنة اولا بمبن العلامة المائلة ثم يبحث عن اصغر رقم يسارا تم عمل قائمة اختيار لاختيار N° Bordereau وكلما اضفت رقما اضيف الى القائمة لك كل الاحترام والتقدير BORDEREAU FACILE1.xlsm

السلام عليكم 🙂 في الواقع ، الموضوع السابق (حيث تم مناقشة معظم الامور المتعلقة بهذه الاحداث) هو المرجع لهذا الموضوع ، وهذا الموضوع به الواجهة فقط 🙂 في الموضوع السابق قلت: . وعليه ، فالحقول الاخرى والتي لا يستطيع Data Macro عملها هي: memo, rich text, hyperlink, OLE Object, multi-value, or attachment fields. . اخواني ابو البشر و عمر ضاحي : تمت الاجابة على اسئلتكم اعلاه. . اخي فادي شكرا لك.

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

المشكلة اني لم اكن اعرف باجبارية فتح الفورم قبل تنفيذ الاستعلام لهذا ما اشتغل معاي والان الحمد لله تم فتحة واضافة تعديل بسيط عليه وتم نسخ الكود في الوحدة النمطية شكرا لك استاذ عمر ضاحي على سعة الصدر وربي يحفظك ويجعله في ميزان حسناتك strSQL = "INSERT INTO kanory ( a, b, c, d) SELECT Bdgi.Obsérvation, Bdgi.PDG_Pr, ""02- المداخيل ( الموارد)"" AS Expr1, ""1"" AS Expr2 FROM Bdgi WHERE (((Bdgi.année)=[Forms]![FrmMasarif]![txtYear]));"

مش شغال ازاي ؟ شغال تمام معي

ما شاء الله ، قيّم وفريد ومتميز في معلوماتك التي تقدمها 😇

إدن لنفترض أننا سنقوم باستخراج البيانات من الأعمدة H:M كما هو ظاهر لديك على الصورة إلى ورقة 2 مثلا Sub CreateShift() Dim lastRow As Long, i As Long, j As Long, kay As String, c As String Dim tbl As Variant, Names As Collection, cell As Range, name As String Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim dest As Worksheet: Set dest = Sheets("Sheet2") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If Application.WorksheetFunction.CountA(dest.Cells) > 0 Then dest.UsedRange.Clear lastRow = WS.Cells(WS.Rows.Count, 8).End(xlUp).Row tbl = WS.Range("H4:M" & lastRow).Value For i = 1 To lastRow - 3 dest.Cells(1, i + 1).Value = tbl(i, 2) dest.Cells(2, i + 1).Value = tbl(i, 1) If Application.CountA(Application.Index(tbl, i, 3)) > 0 Then Colors dest.Cells(1, i + 1), RGB(200, 200, 255) Colors dest.Cells(2, i + 1), RGB(255, 153, 0) End If Next i Set Names = New Collection On Error Resume Next For i = 1 To UBound(tbl, 1) For j = 3 To 6 If tbl(i, j) <> "" Then Names.Add tbl(i, j), CStr(tbl(i, j)) Next j Next i On Error GoTo 0 For i = 1 To Names.Count dest.Cells(i + 2, 1).Value = Names(i) Next i With dest.Range("A1:A2") .ClearFormats: .Merge: .Value = "الإســـم": .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter: .Font.Bold = True .Borders.LineStyle = xlContinuous: .Borders.color = RGB(0, 0, 255) .Interior.color = RGB(200, 200, 255) End With For i = 1 To lastRow - 3 For j = 1 To Names.Count If Not IsEmpty(dest.Cells(j + 2, 1)) Then name = Names(j) c = dest.Cells(1, i + 1).Value kay = "" For Each cell In WS.Range("J4:M" & WS.Cells(WS.Rows.Count, 10).End(xlUp).Row) If cell.Value = name And WS.Cells(cell.Row, 9).Value = c Then kay = (cell.Column - 9) & " مخزن" Exit For End If Next cell dest.Cells(j + 2, i + 1).Value = kay With dest.Range(dest.Cells(j + 2, 1), dest.Cells(j + 2, i + 1)) .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).color = RGB(0, 0, 255) End With End If Next j Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Sub Colors(cell As Range, color As Long) With cell .Interior.color = color .Font.Bold = True .Borders(xlEdgeBottom).LineStyle = xlContinuous End With End Sub New.xlsb

والله أعلى وأعلم على قدر معلوماتى للاسف PlaySound API الخاصة بتشغيل ملفات صوت ذات الامتداد WAV لا تدعم الإيقاف المؤقت/الاستئناف وننتظر من اساتذتنا أهل الخبرة مراجعتنا فى هذه النقطة إن أمكن وهذا تعديل بسيط علشان خاطر عيونك تدلل PlayAudio V0.2.zip

بسم الله ما شاء الله .. تبارك الرحمن 😄🖐🏼️ شغل معلمين بجد .. 😊 الله يبارك لك في عمرك وعلمك وصحتك وذريتك 🤲🏻 أنا كنت عارف أن قلبك مش هيسيبك تدينا الكود وتمشي 😅 اشتغلت معايه زي السكينة على الحلاوة ما شاء الله .. 👍🏼 أيش رايك لو تضيف زر إيقاف مؤقت ⏸ للمجموعة وتكتمل النعمة ؟ والمكتبة بتسلم عليك 😂