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

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

ضع الكود التالي في حدث ورقة Sheet1 سيتم تحديث التسلسل عند اظافة صف او حدفه . وعند كتابة تاريخ جديد في عمود C Private Sub Worksheet_Change(ByVal Target As Range) Dim I As Integer, lastRow As Long Dim WS As Worksheet: Set WS = Sheets("Sheet1") Application.EnableEvents = False Application.ScreenUpdating = False With Target Select Case .Column Case 1, 3 If .Row > 8 Then WS.Range("A9:A" & WS.Rows.Count).ClearContents lastRow = WS.Range("C" & WS.Rows.Count).End(xlUp).Row For I = 9 To lastRow WS.Range("A" & I).Value = Val(WS.Range("A8")) + I - 8 Next I End If End Select End With Application.ScreenUpdating = True Application.EnableEvents = True End Sub اما بخصوص عكس التاريخ ليس له علاقة بالكود المشكلة عندك في تنسيق الملف ان شاء الله اول ما اتفرغ ساحاول تعديل طريقة نسخ البيانات لتتناسب مع طلبك ادا لم يسبقني احد الاخوة في دالك 2024 final DATE.xlsm

غير نوع المتغير من نوع نص الى متنوع وبالتالي نبدل السطر الاول الى Dim currentText As Variant اخونا الشايب

طيب وبعد وقفة طويلة مع النفس وبعد دعوات استاذى الجبيب الاستاذ @ناقل وجدتنى غير راض عن الافكار السابقة لم احس فيها بالمرونة الفائقة فالكود تم تقديمه وفقا لتوجيهات ومتطلبات الدكتورة @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

تم تعديل الكود 2.xls 1.xlsb 3.xlsm

ليه اكتر من يوم متغيب عن المنتدى ودا مش من عادته أن شاء الله خير

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

طيب انا فعلاً لما راجعت الكود وجدت ان فيه خطأ تم التعديل والملف بالمرفق كما أن هناك نص يطبع النتائج ان لم ترده يمكنك حذفه او تعطيله Smart_Search_Pages_V9.zip

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

الف شكر اخي ابو جودي علي دعمك ، اشوفه واقولك يا غالي

أخي الكريم قمت بإضافة بعض الأعمدة لتسجيل الجزء الذي تم اقتطاعه من النص في حالة التطابق الملف بالمرفق 😁 في خانة allFoundMNO يتم تسجيل جميع النتائج المقتطعة اما في خانات الـ MNO يتم تسجيل فقط ما تم مطابقته وللعلم في هذا الكود حتي اعالج قيم المواضع المتأخرة افترضت ان الجزء المقتطع لن يتضمن اسم كتاب أخر حتي اتجنب البحث بأسماء الكتب الأخرى داخل الجزء المقتطع فما أقوم به هو البحث عن و( او و ( ويتم استبدالها باسم الكتاب و( لذا ان كنت تملك أمثلة لتجربة مثل هذه الحالات حتي نتبين الأمر واذا كنت ترغب بتعديل آلية البحث فلا أمانع فأنت المعني باختيار الأفضل والأنسب Smart_Search_Pages_V8.zip

أستاذنا القدير @kanory أستاذنا القدير @شايب كلمات الشكر لا تفيكم حقكم... فالحقيقة أن هذا المثال فتح لي آفاق كثيرة وكبيرة.. مع عدم اعتقادي بدءا بالإمكانية.. ولكن ذلك فضل الله علينا وعليكم في هذه العشر المباركات.. بارك الله لكم في أهلكم ومالكم وولدكم ورضي عنكم ورحم والديكم،، تمت الإجابة ولله الحمد والمنة..

وعليكم السلام ورحمة الله وبركاته اخى عمليه الاستبدال بسيطه لا تحتاج لاكواد قم بالاتي ١ - حدد العامود الذي به الارقام ٢ - قم بالضغط على الزر ctrl + h ٣ - قم بوضع هذه العلامه ٫ واستبدلها بهذه . وستحل المشكله ان شاء الله وستجد انا الارقام اصبحت سليمه مع التركيز علي نفس الفاصله قم باخذها copy

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

استبدل الشيفرة في الزر بهذا .... Dim currentText As Variant Dim newText As String newText = BuildNewText(infoa.Value, anfo2.Value, info3.Value) currentText = allinfo.Value If currentText <> "" Then allinfo.Value = currentText & ", " & newText Else allinfo.Value = newText End If infoa.Value = "" anfo2.Value = "" info3.Value = "" ثم الصق هذا الفانك في النموذج .... Private Function BuildNewText(ParamArray TextValues() As Variant) As String Dim i As Integer Dim textPart As Variant Dim result As String For i = LBound(TextValues) To UBound(TextValues) textPart = Trim(TextValues(i)) If textPart <> "" Then If result <> "" Then result = result & ", " End If result = result & textPart End If Next i BuildNewText = result End Function

بعض التعديلات البسيطة ظهرت مع بعد إجراء بعض التجارب وهي لمعالجة النص الناتج كوجود سطر فارغ زائد علامات لا فائدة منها لذا تم إضافة بعض الأكواد لمعالجة مثل هذه الحالات Smart_Search_Pages_V6.zip

طيب .... استخدم هذه الشيفرة في الزر .... جرب Dim currentText As String Dim newText As String newText = infoa.Value & ", " & anfo2.Value & ", " & info3.Value currentText = allinfo.Value If currentText <> "" Then allinfo.Value = currentText & ", " & newText Else allinfo.Value = newText End If infoa.Value = "" anfo2.Value = "" info3.Value = ""

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

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

استاذ فاضل وعبقرى فى حل المواضيع انت دكتور هذا المنتدى وتعالج كل رواد المنتدى بعد ان تعمل لهم التحاليل اللازمة دكتور بمعنى الكلمة ربنا يزرقك ويسهل لك كل امر عسير ويبارك لك فى اولادك

الاخ الفاضل : اعجبنى كثيرا طريقة ترتيب الجداول والنماذج وطريقة طرح السؤال الان وبعد الاطلاع فقد لاحظت انك لم تذكر بعض النقاط الهامة وهى : - الوحدة القياسية لكل صنف هل هى كيلو جرام فقط ام توجد بعض الوحدات الاخرى لانه بتحديد الوحدة نقوم بتحديد الرصيد النهائى للصنف - وهل اثناء البيع والشراء يمكن ان نشترى مثلا 5.5 او نبيع 3.5 بمعنى هل يوجد كسور اثناء البيع والشراء - وهل البيع والشراء يكون فيها جملة وقطاعى فيلزم تحديد نوع البيع والشراء (جملة ـ قطاعى) - واهم شئ تحديد رقم الفاتورة بالنسبة الشراء والبيع (وانواعها كثيرة) وهى تسلسل عادى (1-2-3 الخ) وتسلسل حسب السنة وتسلسل بان تضعها نص وتكون B1 - S1 - وهل يوجد مرتجعات اثناء للبيع والشراء بمعنى بعد عملية التوريد هل يتم ترجيع منها شئ وكذلك عملية الصرف من المخزن ابشرك الموضوع سهل ويمكن بسهول حساب الرصيد النهائى وهنا الاخوة جميعا لا يقصرون ويساعدون بقدر اوقاتهم والله الموفق

السلام عليكم ورحمة الله وبركاته أخي الكريم لقد قمت بإضافة التعديل للبحث داخل النص عن اسم الكتاب أولاً ولم تتغير النتيجة كما أن الدالة بالفعل تعتمد في البحث عن اسم الكتاب ومع ذلك سأحاول ان اتحقق مرة أخرى إليك النسخة الجديدة في المرفقات وبها تم عمل الدالة المسؤولة عن استخراج الكتب وهي بالأساس تعتمد علي عدد أسماء الكتب المدخلة فقد أضفت اسم كتاب أسد الغابة حتي يظهر بالنتائج قد تأخذ بعض الوقت ولكن إذا كانت مفيدة فهي تستحق الحمد لله ولا حول ولا قوة إلا بالله Smart_Search_Pages_V3.zip فقط بقي أمر واحد وهو معالجة المواضع المتأخرة الحل المقترح في ذهني سيجعل الدالة تعمل لوقت طويل سأحاول التفكير مرة أخرى والله المستعان

استاذ @Zooro1 اذا كان هذا طلبك اضغظ على أفضل اجابة .

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

اعتذر ................ تفضل المرفق mas_s2 - edit(KK1960)-2.rar

تفضل استاذ @2saad المرفق يعمل طبيعي تفضل العرض والمرفق مرة أخرى .ووافني بالرد . mas_s2 - edit(KK1960)-1.rar