ابو جودي

ممكن تجربى الكود ده يا دكتور 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

اسأل الله تعالى ان لا يحرمنا جمعكم الطيب المبارك واتمنى وجودكم فوق رؤوسنا دائما بالخير والصحة وان تكونوا حاضرين متربعين في قلوبنا بكل الحب والمودة كل عام وانتم الى الله تعالى اقرب وعلى طاعتة ادوم وباتباع نبينا صل الله علية وعلى اله وصحبة وسلم احرص.. كل عام وانتم بخير

طيب وحتى لا يقال اننى ناقل عن الاستاذ @ناقل لن اقوم بتعديل الاكواد انا معقد و افضل العمل دائما وفق مرونة واحترافية بقدر الامكان وفقا لذلك هذه طريقتى اولا عمل موديول باسم : basExportReportToPDF الاكواد فى الموديول Option Compare Database Option Explicit ' Function to create directories if they do not exist Public Function CreateDirectoryIfNotExists(ByVal path As String) If Dir(path, vbDirectory) = "" Then MkDir path End If End Function ' Function to export report to PDF Public Function ExportReportToPDF(ByVal patientID As String, ByVal patientName As String, ByVal visitCode As String, ByVal reportName As String, ByVal outputFileName As String) Dim baseFolderPath As String Dim resultsFolderPath As String Dim patientFolderPath As String Dim visitFolderPath As String Dim outputFilePath As String ' Get the base folder path of the current database baseFolderPath = CurrentProject.path ' Define the path for the results folder resultsFolderPath = baseFolderPath & "\results" ' Create the results folder if it does not exist CreateDirectoryIfNotExists resultsFolderPath ' Define the path for the patient folder patientFolderPath = resultsFolderPath & "\" & patientID & "_" & patientName ' Create the patient folder if it does not exist CreateDirectoryIfNotExists patientFolderPath ' Define the path for the visit folder visitFolderPath = patientFolderPath & "\" & visitCode ' Create the visit folder if it does not exist CreateDirectoryIfNotExists visitFolderPath ' Define the output file path outputFilePath = visitFolderPath & "\" & outputFileName & ".pdf" ' Export the report to PDF DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, outputFilePath ' Notify the user MsgBox "Report has been exported to: " & outputFilePath, vbInformation End Function ثانيا زر امر فى النموذج على ان يكون الكود داخل زر الامر كالاتى Dim patientID As String Dim patientName As String Dim visitCode As String Dim reportName As String Dim outputFileName As String ' Set the values for the parameters patientID = "12345" patientName = "Moh3sam" visitCode = "2024-06-11" reportName = "rptTest" outputFileName = "YourOutputFileName" ' Call the function to export the report to PDF ExportReportToPDF patientID, patientName, visitCode, reportName, outputFileName وطبعا تحياتى وكل تقدير لاستاذى الجليل ومعلمى القدير الاستاذ @ناقل قطعا بدأت مشاركتى بمداعبة استاذى القدير . وهذه قاعدة البيانات بالتطبيق export report to PDF.accdb

ممكن نفكر بصوت عالى انا موافق بعمل الاتى فى المجلد الاساسى الحالى لقاعدة البيانات يتم عمل مجلد باسم results وبداخل المجلد results يتم عمل مجلد ID لكود المريض مع اسم المريض وبداخل مجلد ID يتم عمل مجلد بكود الزيارة او بالتاريخ لسهولة تتبع التقارير مستقبلا من المجلدات حتى وبدون فتح قاعدة البيانات ايه راي حضرتك يا دكتور ؟؟ واعتقد اسم التقرير فقط مجموعة التحاليل يكون افضل

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

انظر الى القاعدة الان هذا البناء الافضل اكمل باقى الجداول على هذا المنوال ومن ثم نكمل المراد خطوة بعد خطوة برنامج الحد الادنى (V. 2) .accdb

اليك النصائح الاتية وهى مهمه طالما انت فى البدايات 1- اختر للجداول دائما وباقى العناصر والكائنات اسماء مختصرة تدل على وظيفتها 2-استعمل اختصارات البادئات المتعارف عليها قدر الامكان مثل Table=tbl Form=frm Query=qry Module=bas وسوف ارفق لك ملف كنت حاولت جاهدا تجميعه قبل فترة هذه الاختصارات اثناء التعامل مع الاكواد تجعلك على دراية بما تتعامل معه بسهولة وتجعل اى مطور نظم ان كنتم تعملون فى مجموعة عمل سهولة فهم الية الاكواد وتتبع المشروع ومعك انت شخصيا انت الان وقت التصميم تكون على دراية بكل صغيرة وكبيرة ولكن بعد فترة سوف تنسى كل شئ هذه البادئات تجعلك دائما على دراية مع ماذا تتعامل من العناصر والكائنات المختلفة فتسهل عليك مراجعة وتتبع وتذكر الاكواد والية العمل 3- دائما لا تبخل على نفسك فى استخدام الجداول المساعدة التى تغنيك عن فتح التصميم مستقبلا لاضافة شئ او حذف وتعديل شئ على سبيل المثال وليس الحصر الاولى بك فى قاعدتك الحالية عمل جدول للوظائف بدلا من كتابة الوظائف فى حقل واحد بهذه الطريقة مستقبلا لو اردت تغير اسم وظيفه او اضافتها لابد لك من الدخول الى التصميم وناهيك عن المشاكل التى لا حصر لها لو اردت تغير مسمى مثلا وانت تعتمد فى الاكواد على هذا المسمى دعنى اعيد بناء قاعدتك بالشكل الامثل من وجهة نظرى المتواضعة وانت اكمل باقى خطاك فى هذا الدرب بناء على ما اقدمه اليكم اولا اليك الاختصارات المتعارف عليها بين مطورى النظم والمبرمجين فى ملف نصى prefix.zip

ممكن تجرب الكود ده Dim ImagePath As String s1 = Str(Me![رقم الجلوس]) s1 = Right(s1, Len(s1) - 1) ImagePath = "D:\صور\" & s1 & ".jpg" On Error Resume Next Me![Image_Std].Picture = ImagePath If Err.Number <> 0 Then MsgBox "لا توجد صورة مطابقة لرقم الجلوس", vbExclamation, "خطأ" Err.Clear End If On Error GoTo 0 End Sub

هل تريد مجرد الاجابة للوضع الحالى لقاعدتك ام تريد النصيحة لعمل ذلك بالشكل الصحيح و الاحترافى كما ينبغى ان يكون لاضفاء المرونة والاحترافية فى التعامل ومعالجة البيانات ؟! لن اضع الاجابة قبل ردكم

ومشاركة مع اخى الحبيب الأستاذ @Foksh ممكن أيضا مع الحدث "On Key Press" Private Sub Combo4_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub وهذا افضل للمصمم ومطور النظم لان ما تفضل بها اخى الحبيب يمنع الدخول الى محرر الاكواد اثناء فتح النموذج من خلال - الضغط على مفتاحى Alt + F11 من لوحة المفاتيح - او من خلال الضغط علىم فتاحى Ctrl +G من لوحة المفاتيح واحيانا نحتاج الى الدخول الى محرر الاكواد بدون اغلاق النموذج لانه احيانا نستخدم امر الطباعة Debug.Print فى الاكواد لتتبع الاكواد وسير الكود لطباعة النتائج فى نافذة Immediate مش قولت لك هافوق لك يا حاج @Foksh كده انا افضل اجابة بالعند فيك

انا اسف لم انتبه وفقدت التركيز تم التعديل حفظ وتعديل (4).accdb

لو ده شكلك وانت بتبص ع الاكواد دا كان شكلى وانا باكتبها وافكر فيها