ابو جودي

ابشر انا بالفعل اقوم فى هذه اللحظة بذلك الان فى موضوع مستقل سوف يكون عنوانه : تفكيك كود لتقديم النصائح و أفكار وحيل وأسرار الكود

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

السلام عليكم ورحمة الله تعالى وبركاته عارف ان الموضوع قديم وانا كنت قلت عاوز لها روقان واحلى سطل شاى وللاسف كان عندى مشكلة فى الشاى وبمجرد حل المشكلة عدت اليكم سريعا شوفوا انا بصراحة كنت بدأت في التصميم ولا اعرف سبب انشغالي واليوم وانا ابحث عن شيء في حاسوبي وجدت المرفق وتذكرت الموضوع وقررت ان اكمل ما بدأته أعجبتني أفكار الأستاذ @Moosak وختامها مسك طبعا ابهرني أستاذي الجليل ومعلمي القدير الأستاذ @أبو إبراهيم الغامدي ساحر ربط الاكس بلغة الـ HTML وأخيرا أفكاري المتواضعة OfficenaPattern.accdb

من واقع المرفق ايه الكود اللى بينفذ طلبك اللى فى الحدث الحالى ؟؟

خير الكلام ما قل ودل واجيبك بقوله تعالى يعلم السر واخفى اخى يا رعاك الله لا تجتزئ الكلام تركت كل الرد وفقط تعلق على الكلمة بخيل اكثر ما اكرهه هو تصيد أخطاء الاخرين على كل كان توجيه في صورة مزاح ولتعلم كل ما يقدم هنا ابتغاء مرضاة الله ولوجه الله تعالى ولا نحتسب ما نقدم الا كذلك اذا انت شخص جاسر وجسور ولا تفهم ولا تحب المزاح اعتذر اليك ردى السابق بصفة شخصية لا علاقة له بأى القاب تتبعها عضويتي لأنه لا نتعامل هنا باي القاب التعامل هنا كما سبق و أوضحت لوجه الله تعالى أخى الحبيب كن هين لين وبما انك عضو جديد وبما انك لك كل الحق في طرح اسئلتك لتحصل من وراء ذلك مبتغاك عليك واجبات كذلك اذا اتبع الواجبات حتى تحصد الحقوق اول الواجبات كان اولى بك قبل المشاركة قراءة قوانين المنتدى https://www.officena.net/Tips/Questions.htm والتى ستجد ضمنها على سبيل المثال والذى كان سببا فى عدم حصولك على النتيجة طيب وقبل مغادرتي فهم السؤال بشكل نموذجي يعين على الإجابة عليه بشكل نموذجي فهم السؤال جيدا يوفر علينا وقت وجهد ثمينين نهدرهما اطرح سؤالك بشكل كاف وبين الهدف والسيناريو وفق المرفق حتى تجد من يستطيع مساعدتك اهلا بك بين اخوانك

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

السلام عليكم ورحمة الله تعالى وبركاته اعرف ان الفكرة نوعا ما ليست جديدة كليا ولكن انا قمت بتطوير الفكرة بقدر الإمكان وفق رؤيتي القاصرة المرفق والفكرة مازالت قيد التجربة والتطوير لذلك اطلب العفو والسماح في حال وقوع أي أخطاء في انتظار آرائكم وارحب بإضافة الأفكار طبعا و يحبذا لو يتم تطبيق عمليا على المرفق مباشرة وإعادة رفعه من جديد OfficenaSQL2VBA.accdb

هو غباء وليس ذكاء مطلقا انا عن نفسى كانت تجربتى معه سيئة جدا جدا جدا

أستاذي الجليل و معلمي القدير و والدى الحبيب الأستاذ @jjafferr ممكن مرفق بسيط لهذه الفكرة العبقرية لتتضح الأمور بشكل اكبر و لتكون مرجعا لكل دارس

شوفى يا دكتور دا شئ طبيعى هذه المشكلة بسبب استخدام الكود VBA لتعيين RecordSource للنموذج فتتأخر عملية تحميل البيانات بسبب تنفيذ الاستعلام في كل مرة يتم فيها فتح النموذج و هذا يحدث لأن الاستعلام يتم إعداده وتنفيذه في وقت التشغيل (runtime) ولكن عند استخدام الاستعلام المحفوظ مسبقا في النموذج يتم تحميل البيانات بشكل أسرع لأنه يتم تحميلها مباشرة من قاعدة البيانات دون تأخير إضافي ايه وجه السبب في تحويل الاستعلام بدل من استخدامه مباشرة كمصدر بيانات للنموذج الى تحويله الى كود أولا ثم تمريره الى مصدر بيانات النموذج ؟؟!

انا اسف يا دكتور تسرعت بوضع الرد ولم انتبه الى ان حضرتك عاوزة جملة الاستعلام فى الكود تكون RecordSource اتفضلى Sub SetFormRecordSource() Dim sql As String Dim formID As String ' Get the value of the ID field from the form formID = Forms!visit_frm!ID ' Build the SQL query sql = "SELECT CBC_tbl.ID, CBC_tbl.tdate, CBC_tbl.code, CBC_tbl.age, CBC_tbl.hgb, CBC_tbl.hgb_s, " & _ "CBC_tbl.rbc, CBC_tbl.rbc_s, CBC_tbl.hct, CBC_tbl.hct_s, CBC_tbl.hgbp, CBC_tbl.mcv, " & _ "CBC_tbl.mcv_s, CBC_tbl.mch, CBC_tbl.mch_s, CBC_tbl.mchc, CBC_tbl.mchc_s, CBC_tbl.rdwcv, " & _ "CBC_tbl.rdwcv_s, CBC_tbl.rdwsd, CBC_tbl.rdwsd_s, CBC_tbl.plt, CBC_tbl.plt_s, CBC_tbl.pct, " & _ "CBC_tbl.pct_s, CBC_tbl.pdw, CBC_tbl.pdw_s, CBC_tbl.mpv, CBC_tbl.mpv_s, CBC_tbl.wbc, CBC_tbl.wbc_s, " & _ "CBC_tbl.netp, CBC_tbl.netp_s, CBC_tbl.lymp, CBC_tbl.lymp_s, CBC_tbl.monp, CBC_tbl.monp_s, " & _ "CBC_tbl.eosp, CBC_tbl.eosp_s, CBC_tbl.basp, CBC_tbl.basp_s, CBC_tbl.net, CBC_tbl.net_s, " & _ "CBC_tbl.lym, CBC_tbl.lym_s, CBC_tbl.mon, CBC_tbl.mon_s, CBC_tbl.eos, CBC_tbl.eos_s, " & _ "CBC_tbl.bas, CBC_tbl.bas_s, CBC_tbl.MIDp, CBC_tbl.MIDp_s, CBC_tbl.Mid, CBC_tbl.MID_s, " & _ "CBC_tbl.comment, CBC_tbl.segmp, CBC_tbl.segmp_s, CBC_tbl.bandp, CBC_tbl.bandp_s, " & _ "CBC_tbl.segm, CBC_tbl.segm_s, CBC_tbl.[band], CBC_tbl.band_s, CBC_tbl.WBC_HISTOGRAM, " & _ "CBC_tbl.RBC_HISTOGRAM, CBC_tbl.PLT_HISTOGRAM " & _ "FROM CBC_tbl " & _ "WHERE CBC_tbl.ID=" & formID & ";" ' Set the RecordSource of the form Me.RecordSource = sql End Sub Private Sub Form_Open(Cancel As Integer) SetFormRecordSource End Sub

ممكن تجربى الكود ده يا دكتور Sub RetrieveCBCData() Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Dim formID As String ' Open the current database Set db = CurrentDb ' Get the value of the ID field from the form formID = Forms!visit_frm!ID ' Build the SQL query sql = "SELECT CBC_tbl.ID, CBC_tbl.tdate, CBC_tbl.code, CBC_tbl.age, CBC_tbl.hgb, CBC_tbl.hgb_s, " & _ "CBC_tbl.rbc, CBC_tbl.rbc_s, CBC_tbl.hct, CBC_tbl.hct_s, CBC_tbl.hgbp, CBC_tbl.mcv, " & _ "CBC_tbl.mcv_s, CBC_tbl.mch, CBC_tbl.mch_s, CBC_tbl.mchc, CBC_tbl.mchc_s, CBC_tbl.rdwcv, " & _ "CBC_tbl.rdwcv_s, CBC_tbl.rdwsd, CBC_tbl.rdwsd_s, CBC_tbl.plt, CBC_tbl.plt_s, CBC_tbl.pct, " & _ "CBC_tbl.pct_s, CBC_tbl.pdw, CBC_tbl.pdw_s, CBC_tbl.mpv, CBC_tbl.mpv_s, CBC_tbl.wbc, CBC_tbl.wbc_s, " & _ "CBC_tbl.netp, CBC_tbl.netp_s, CBC_tbl.lymp, CBC_tbl.lymp_s, CBC_tbl.monp, CBC_tbl.monp_s, " & _ "CBC_tbl.eosp, CBC_tbl.eosp_s, CBC_tbl.basp, CBC_tbl.basp_s, CBC_tbl.net, CBC_tbl.net_s, " & _ "CBC_tbl.lym, CBC_tbl.lym_s, CBC_tbl.mon, CBC_tbl.mon_s, CBC_tbl.eos, CBC_tbl.eos_s, " & _ "CBC_tbl.bas, CBC_tbl.bas_s, CBC_tbl.MIDp, CBC_tbl.MIDp_s, CBC_tbl.Mid, CBC_tbl.MID_s, " & _ "CBC_tbl.comment, CBC_tbl.segmp, CBC_tbl.segmp_s, CBC_tbl.bandp, CBC_tbl.bandp_s, " & _ "CBC_tbl.segm, CBC_tbl.segm_s, CBC_tbl.[band], CBC_tbl.band_s, CBC_tbl.WBC_HISTOGRAM, " & _ "CBC_tbl.RBC_HISTOGRAM, CBC_tbl.PLT_HISTOGRAM " & _ "FROM CBC_tbl " & _ "WHERE CBC_tbl.ID=" & formID & ";" ' Open the recordset based on the SQL query Set rs = db.OpenRecordset(sql, dbOpenDynaset) ' Check if the recordset is not empty If Not rs.EOF Then ' Display data (you can modify this part to display data in a form or use the data as needed) MsgBox "Data retrieved successfully." Else MsgBox "No data found for the given ID." End If ' Close the recordset and the database rs.Close Set rs = Nothing Set db = Nothing End Sub

اثراء للموضوع و مشاركة مع أستاذي القدير و معلمي الجليل الأستاذ @AlwaZeeR قبل أن نخوض في خضم الكود وجب التنويه الى انه يمكن تحقيق ذلك بأحدي الطريقتين الطريقة الأولى تعتمد على DAO.Recordset الطريقة الثانية تعتمد على Form.Recordset - الطريقة التي تعتمد على DAO.Recordset تكون أكثر مرونة وقابلة للتوسع خاصة إذا كنت تحتاج للوصول إلى بيانات خارج نموذج معين أو تنفيذ عمليات أكثر تعقيدا - الطريقة التي تعتمد على Form.Recordset تكون أكثر مباشرة وسهلة الاستخدام عندما يكون الهدف هو التفاعل مع السجلات المعروضة في النموذج الحالي حتما طالما انه نريد التعامل مع جميع السجلات في احد الجداول من خلال عمل لوب عليها وقطعا طالما ان هناك شرط بناء على مربع نص اذا هذا الشرط سوف يكون مرتبط بأحد الحقول داخل الجدول ولذلك سوف نأخذ هذا في الاعتبار عند كتابة الكود - الطريقة الأولي : Private Sub Form_Load() ' تعريف متغيرات قاعدة البيانات Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim yourVariable As String ' المتغير العام الذي يعتمد عليه الأمر ' تعيين المتغير العام yourVariable = YourTextBox ' تعيين قاعدة البيانات الحالية Set db = CurrentDb ' SQL الاستعلام الذي يجلب كل السجلات من الجدول strSQL = "SELECT * FROM YourTableName" ' فتح مجموعة السجلات Set rs = db.OpenRecordset(strSQL) ' التحقق من أن مجموعة السجلات ليست فارغة If Not rs.EOF Then rs.MoveFirst ' لوب على جميع السجلات Do While Not rs.EOF ' تنفيذ الأمر بناء على المتغير العام If rs!FieldName = yourVariable Then ' هنا تضع الأمر الذي تريده MsgBox "Record found with your variable value!" End If ' الانتقال للسجل التالي rs.MoveNext Loop End If ' إغلاق مجموعة السجلات rs.Close Set rs = Nothing Set db = Nothing End Sub - الطريقة الثانية : Private Sub Form_Load() Dim rs As DAO.Recordset Set rs = Me.Recordset.Clone rs.MoveFirst Do While Not rs.EOF If rs.Fields("YourFieldName").Value = "شرط جملة اف" Then MsgBox "قم بتطبيق شرط اف" End If rs.MoveNext Loop Set rs = Nothing End Sub وحتى لا يتم السؤال لاحقا عن اى الطريقتين افضل ! : الكود الأول (DAO) قد يكون أكثر كفاءة إذا كنت تحتاج إلى إجراء عمليات معقدة أو تحتاج إلى التعامل مع جداول ليست مرتبطة بالنموذج الكود الثاني (Form.Recordset) بسيط وسهل الفهم ومناسب للتفاعلات السريعة مع السجلات المعروضة في النموذج استخدام الطريقة الأولى إذا كنت تحتاج إلى مرونة أكبر أو تعمل مع بيانات ليست مرتبطة مباشرة بالنموذج استخدام الطريقة الثانية في حال كان الهدف هو التفاعل مع البيانات المعروضة في نموذج معين وكان الهدف واضح ومباشر اختيار الطريقة يعتمد على السياق واحتياجات التطبيق الخاص بك انت و كلا الطريقتين يمكن أن تكون سريعة وفعالة إذا تم تطبيقها بشكل صحيح هام وعاجل : تم كتابة التعليقات والتلميحات باللغة العربية للتبسيط و لدواعي الشرح فقط ولا أحبذ ذلك قطعا تجنبا لمشاكل اللغة العربية مع محرر الأكواد

السلام عليكم ورحمة الله وبركاته الموضوع ترفيهي نوعا ما : حنين الى الماضي بصراحة كنت احب هذه اللعبة جدا جدا جدا وانا صغير راودتني فكرة تصميم اللعبة من خلال الاكسس وهذه تجربتي اتمني ان تنال رضاكم PuzzleGame.zip

مش عارف ليه عندى احساس عميق @hanan_ms هو نفس العضو باسم Ezril نفس اسلوب العرض وتقريبا نفس اسلوب تقديم قواعد البيبانات بالتنسيق والافكار

يا هلا والله اشتقنا اذا حضر الماء بطل التيمم استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr كل عام وانتم بخير ادامك الله فوق رؤوسنا

1- الكود ده فى وخدة نمطية Function GetDateRange() As String Dim startDate As Date Dim endDate As Date Dim currentYear As Integer Dim currentMonth As Integer currentYear = Year(Date) currentMonth = Month(Date) ' Determine the start of the period (27th of the previous month) If currentMonth = 1 Then startDate = DateSerial(currentYear - 1, 12, 27) Else startDate = DateSerial(currentYear, currentMonth - 1, 27) End If ' Determine the end of the period (26th of the current month) endDate = DateSerial(currentYear, currentMonth, 26) GetDateRange = "# " & startDate & " # And # " & endDate & " #" End Function 2-في النموذج الذي يحتوي على مربع النص استخدم الكود الاتى في مصدر التحكم لمربع النص =DSum("[m_price]", "[Qry_UNION_MOKHTABER]", "date_R Between " & GetDateRange())

ليه الصدمة يا باش مهندسة مش فاهم حضرتك تقصدى ايه وبعد اذنك عجبتنى الفكرة واستأذن فى عمل بعض التعديلات ولان صاجب الموضوع طلب التعامل مع المسارات استكفيت بالرد طبقا للمسارات بابسط واسهل واسرع طريقة بدون اكواد لان بهارتى كانت خلصت ولكن يا استاذى القدير و معلمى الجليل استاذ @AlwaZeeR بما انك اقترحت ارد بضاعتكم اليكم على طريقتى مع بهاراتي الخاصة كله عمال يحط بهارت جت على انا يعنى لن اشرح شئ ولكن انتظر منكم الرد بعد التجربة الكود ذكى وشاطر لما بيقتح بدون مسارات بيطلب منك تحدد مجلد الصور ومن تلقاء نفسه وبذكائه يروح جايب مسارت الصور ونركز فى كلمة الصور دى يعنى ممكن نشاور له على مجلد فيه ملفاااااااااات كتير قوى سوف لن يجلب الا مسارات الصور فقط Images V2.accdb

سوف اقوم ببعض التعديلات

ممكن مرفق

لا انا قصدتها تماما ولكن امازح بها اخى صاحب المكتبة العامرة الاستاذ @Moosak

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

مرفق للتجربة فقط للتجربة وليس للإضافة الى المكتبة العامرة img.zip

بسيطة اعمل الاتى اولا جدول باسم tblImages اضف الى الجدول الحقول الاتية ImagePath (مسار الصورة، نص) StartDate (تاريخ بداية صلاحية الصورة، تاريخ/وقت) EndDate (تاريخ انتهاء صلاحية الصورة، تاريخ/وقت) انشئ نموذج بالاسم الذى تريد اضف عنصر تحكم صورة غير منضم على ان يكون اسمه مثلا objImg وضع الاكواد الاتية Option Compare Database Option Explicit Const DelayInSeconds As Integer = 5 ' Passing time in seconds Private Sub Form_Open(Cancel As Integer) ' Assigning the image control to an empty image when the form opens Me.objImg.Picture = "" ' Running the form's timer Me.TimerInterval = 1000 End Sub Private Sub Form_Timer() Static rs As DAO.Recordset Static ImageCounter As Integer Dim ImagePath As String ' Checking for the existence of the selected records set If rs Is Nothing Then Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblImages WHERE EndDate >= Date()") ImageCounter = 0 ' Resetting the image counter End If ' Checking for the existence of images to display If Not rs.EOF Then ' Displaying the images sequentially with a time delay ImagePath = rs!ImagePath Me.objImg.Picture = ImagePath ' Replace YourImageControl with the correct name of the image control in the form Me.Refresh ' Waiting for the time delay before displaying the next image Delay DelayInSeconds rs.MoveNext ImageCounter = ImageCounter + 1 ' Checking if we have reached the last record If rs.EOF Then ' Closing the form when reaching the last record DoCmd.Close acForm, Me.Name End If Else ' No images to display MsgBox "No images to display.", vbInformation, "Image Display" ' Closing the form if there are no images to display DoCmd.Close acForm, Me.Name End If End Sub Private Sub Delay(seconds As Integer) Dim endTime As Date endTime = DateAdd("s", seconds, Now) Do Until Now >= endTime DoEvents Loop End Sub تم تعريف ثابت لتحديد فاصل الزمن بالثواني في رأس الاكواد في النموذج في حدث فتح النموذج يتم تعيين الصورة لتكون فارغة وتشغيل المؤقت في حدث المؤقت يتم فتح مجموعة السجلات وفحص وجود الصور للعرض إذا كان هناك صور يتم عرض الصورة الحالية وانتظار الفاصل الزمني بعد ذلك يتم التحقق مما إذا كان السجل الحالي هو الأخير وإذا كان كذلك يتم إغلاق النموذج والكود يعتمد على جدول يحتوي على مسارات الصور مع تواريخ بداية ونهاية لكل صورة

طيب وبعد وقفة طويلة مع النفس وبعد دعوات استاذى الجبيب الاستاذ @ناقل وجدتنى غير راض عن الافكار السابقة لم احس فيها بالمرونة الفائقة فالكود تم تقديمه وفقا لتوجيهات ومتطلبات الدكتورة @safaa salem5 ولذلك اقدم اليكم الاكواد مرة اخرى بشكل اكثر مرونة لتحقيق اكبر قدر ممكن من الاستفادة بشكل عام مع اى قاعدة وفق اى متغيرات اخرى اولا دالة لعمل مجلد او مجلدات وفق الكود التالى ' Function to create directories if they do not exist Public Function CreateDirectories(ByVal basePath As String, ByVal folderNames As String) As String Dim fullPath As String Dim folderArray() As String Dim folderName As Variant ' Split the folderNames string into an array folderArray = Split(folderNames, ",") fullPath = basePath ' Loop through each folder name and create the directory if it doesn't exist For Each folderName In folderArray fullPath = fullPath & "\" & Trim(folderName) If Dir(fullPath, vbDirectory) = "" Then MkDir fullPath End If Next folderName ' Return the final full path CreateDirectories = fullPath End Function دالة تصدير اى تقرير ' Function to export report to PDF Public Function ExportReportToPDF(ByVal reportName As String, ByVal outputFilePath As String) On Error GoTo ErrorHandler ' Export the report to PDF DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, outputFilePath ' Notify the user MsgBox "Report has been exported to: " & outputFilePath, vbInformation Exit Function ErrorHandler: MsgBox "An error occurred: " & Err.Description, vbExclamation End Function واخيرا كود زر الامر Dim baseFolderPath As String Dim folderNames As String Dim finalFolderPath As String Dim outputFilePath As String Dim patientID As String Dim patientName As String Dim visitCodeORvisitDate As String Dim reportName As String Dim outputFileName As String ' Set the values for the parameters patientID = "12345" patientName = "Moh3sam" visitCodeORvisitDate = "2024-06-11" outputFileName = "YourOutputFileName" ' Set the values for the base path and folder names baseFolderPath = CurrentProject.path ' The base path of the current database folderNames = "results" & "," & patientID & "_" & patientName & "," & visitCodeORvisitDate ' Comma-separated folder names ' Create the directories and get the final path finalFolderPath = CreateDirectories(baseFolderPath, folderNames) ' Set the report name and output file path reportName = "rptTest" ' The name of the report outputFilePath = finalFolderPath & "\" & outputFileName & ".pdf" ' The desired output file name with full path ' Call the function to export the report to PDF ExportReportToPDF reportName, outputFilePath وهذا المرفق النهائى.. export report to PDF V. 2.accdb