jjafferr

السلام عليكم 🙂 هذه آخر محاولة لي ، وقد قمت بتغيير العمل: Option Compare Database Option Explicit Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer 'unify endline characters, so that we can use Split function myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, Chr(10) & Chr(13), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) ' myValue = Replace(myValue, " ", " ") ' myValue = Replace(myValue, " ", " ") ' myValue = Replace(myValue, " ", " ") 'convert the one paragraph into different phrases separated by vbcrlf x = Split(myValue, vbCrLf) 'Loop through the phrases For j = 0 To UBound(x) 'remove the extra spaces on the Left x(j) = Trim(x(j)) If Len(x(j)) > 1 And j <> UBound(x) Then 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it 'only if the right character is a spcae and its not the last phrase x(j) = Trim(Mid(x(j), 1, Len(x(j)) - 1)) & vbCrLf End If 'Remove the Empty lines (one character length), and accumelate the rest of the lines If Len(x(j)) < 2 Then Else Remove_Extras = Remove_Extras & x(j) End If Next j 'this is an Access conversion error, so lets uninfy it like all endlines Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'replace the VT characters with vbcrlf 'if the last character is vbcrlf, remove it, so that we dont have extra empty line at the end If Right(Remove_Extras, 1) = vbCrLf Or Right(Remove_Extras, 1) = Chr(10) Or Right(Remove_Extras, 1) = Chr(13) Then Remove_Extras = Mid(Remove_Extras, 1, Len(Remove_Extras) - 2) End If End Function جعفر أسطر3.zip

جرب هذا الكود : Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer Dim mySpace As String For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) 'remove the extra spaces on: x(j) = LTrim(x(j)) 'remove the left spaces If Len(x(j)) < 2 Then Else 'remove the extra spaces on: x(j) = LTrim(x(j)) 'remove the left spaces 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it 'only if the right character is a spcae mySpace = Mid(x(j), 1, Len(x(j)) - 1) If Right(mySpace, 1) = " " Then x(j) = Trim(mySpace) & vbCrLf End If Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function جعفر

شوف المرفق. ما فهمت !! خليني اشوف اللي عملته 1311.4.Data.accdb.zip

اما تجربتي فتقول ، قبل: . وبعد: . جرب المرفق 🙂 جعفر أسطر2.zip

تفضل يا سيدي 🙂 . جعفر 1311.4.Data.accdb.zip

وتعديل آخر: Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer Dim mySpace As String For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) If Len(x(j)) < 2 Then Else 'remove the extra spaces on: x(j) = LTrim(x(j)) 'remove the left spaces 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it 'only if the right character is a spcae mySpace = Mid(x(j), 1, Len(x(j)) - 1) If Right(mySpace, 1) = " " Then x(j) = Trim(mySpace) & vbCrLf End If Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function . ولكن المطلوب ليس تحويل المسافات الى مسافة واحدة ، وانما المطلوب حذف هذه المسافات/المسافة 🙂 قاعدة البيانات المرفقة فيها مثال ، فجرب كودك عليها 🙂 جعفر

يعني قصدك هكذا:

اخوي هاوي 🙂 بعض الاحيان ، وبمجرد رؤية المطلوب ، تقفز الحلول الى الخاطر ، ولكن وبعد التجربة ، نرى ان بعض هذه الحلول لا تعطي النتائج الصحيحة ، والنقطة اللي نتناقش حولها هي مثل هذا الاحتمال: مسافة مسافة 1234 مسافة مسافة vbcrlf الدالة Trim واخواتها ممكن ان يحذفو المسافات الفارغة قبل وبعد اي قيمة ، ولكن في حال المثال اعلاه ، فإن الدالة ستقوم بحذف المسافات في مقدمة الرقم ، سواء Trim او LTrim، ولكن وبسبب وجود اشارة السطر التالي vbcrlf ، فالمسافات التي قبلها لن تحذفها الدالة ، فعليه ، يكون نتيجة اجراء الدالة: 1234 مسافة مسافة vbcrlf لهذا السبب ، فالموضوع يتطلب اجراء اضافي 🙂 جعفر

نعم ،مكان الكود كان في السطر الخطأ !! اما الآن ، وبعد التجربة ، فهو شغال تمام ان شاء الله 🙂 هكذا اصبحت الدالة: Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines 'unify the end of the line characters myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) If Len(x(j)) < 2 Then Else 'remove the extra spaces on: 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it x(j) = Trim(Mid(x(j), 1, Len(x(j)) - 1)) & vbCrLf Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function جعفر أسطر2.zip

السلام عليكم 🙂 هل افهم انك تحتاج التقارير بهذه الطريقة: . 1. . 2. . جعفر

انا مطمئن لما اتعامل مع عمالقة مثلك ومثل اخونا الكبير ابو الكرم ، وكل اللي تقولوه على راسي 🙂 بس كنت خايف من الحرفين الباقين ، ترى الدكتور حسنين مو سهل ، يسحبنا شوي شوي 😁 جعفر

الحمد لله اننا لازلنا محافظين على قوانين المنتدى ، بقية بس شعرة واحدة وننزلق الى المحظور 😁 جعفر

كلامك يخص كلمة سر البرنامج ، اما بالنسبة الى كلمة سر VBA ، فلا ينطبق عليها هذا 😁 جعفر

توجد طرق وبرامج ، ولكن قصدك ان قوانين المنتدى لا تسمح برفع مثل هذه الامور ، للحماية الفكرية لصاحب الموضوع 🙂 وقصدك انه لا يوجد شي لتخطي أو الغاء باسورد VBA أبداً ، اذا كان البرنامج بصيغة mde او accde 🙂 جعفر

لا اعلم اذا هذا له علاقة بالموضوع ، ولا استبعد ذلك !! ولا تحذف اي ملف الآن ، هناك خطأ في التعليمات اعلاه ، فلا نحتاج الى نسخه الى مجلدات النظام (وتم تحديث التعليمات اعلاه) هكذا : C:\Windows\system32>regsvr32 "C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll" او حسب نظامك C:\Windows\system32>regsvr32 "C:\Program Files (x86)\Common Files\Microsoft Shared\DAO\dao360.dll" . جعفر

اخي nssj لا انصحك بالخلط بين الاكواد ، فمنها سيكون متكرر ، فيعمل بطئ في برنامجك ، وتستطيع ان تضعه هنا ، ليقوم الاعضاء بتصحيحه 🙂 حيا الله اخوي الهاوي 🙂 نعم اعرف هذا ، ولكن لم تنجح التجربه به !! تفضل هذا المرفق ، ولاحظ المسافات حسب ما اوضحتها ، جرب واخبرنا 🙂 . واتضح ان كودي يحتاج الى تعديل ليحل هذه الاشكاليه كذلك : 'remove the extra spaces on: 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it x(j) = Trim(Mid(x(j), 1, Len(x(j)) - 1)) & vbCrLf . جعفر أسطر2.zip

الظاهر انك استخدمت صيغة mdb ، ووجدت هذا الجواب في احد المواقع: 1. ابحث في جهازك عن ملفات doa3*.dll ، واحذفها جميعا ، ولا تحذف ملف dao360.dll الموجود في : لنظام 32بت C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll لنظام 64بت C:\Program Files (x86)\Common Files\Microsoft Shared\DAO\dao360.dll 2. ثم سجل الملف dao360.dll كمسؤول في برنامج cmd : لنظام 32بت C:\Windows\system32>regsvr32 "C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll" لنظام 64بت C:\Windows\system32>regsvr32 "C:\Program Files (x86)\Common Files\Microsoft Shared\DAO\dao360.dll" لتحصل على هذه الرسالة المؤكدة بنجاح الامر: 3. واعد تشغيل الكمبيوتر ، ثم جرب البرنامج مرة اخرى 🙂 جعفر

تفضل: تم اضافة : 'remove the extra spaces on: x(j) = LTrim(x(j)) 'the Left x(j) = RTrim(x(j)) 'the Right Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) 'remove the extra spaces on: x(j) = LTrim(x(j)) 'the Left x(j) = RTrim(x(j)) 'the Right If Len(x(j)) < 2 Then Else Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function جعفر

انت عامل نموذج فردي ، فطبيعي يتغير السجل اللي انت عليه فقط ، بينما لو عملته في استعلام تحديث (كما عملتها لك في النموذج المرفق) ، تشغل الاستعلام ولما ينتهي من التحديث ، افتح النموذج وسترى كل شيء جاهز. أسطر2.accdb

اولا: ميزة الوحدة النمطية انك تقدر تستفيد منها في هذا النموذج وذاك ، بينما اذا كتبتها في الكود ، لازم تعيده في كل نموذج ، ثانيا: شغلك مضبوط ، ولكن في الاكسس ، علشان تحفظ السجل ، يجب الذهاب الى سجل آخر ، ثم العودة الى هذا السجل لترى التغيير عليه ، او تحفظ السجل برمجيا بعد مناداة الدالة ، والطريقة الاولى افضل 🙂 ويكون افضل اذا تجعل الحقل ID يكون عليه التركيز ، بحيث تغير اعداداتع الى صفر : حيا الله الدكتور 🙂 الكود لا يحذف الاسطر الفارغة اذا كانت اول السطر او بين الاسطر !! جعفر

اعمل وحدة نمطية جديدة ، واحفظها لاحقا بإسم mod_Remove_Extras ، والصق الدالة اعلاه في هذ الوحدة النمطية ، ثم احذف الدالة القديمة من برنامجك (هذه الخطوة مهمة حتى لا يتكرر سم الدالة مرتين في برنامجك) ، كودك القديم سيعمل بطريقة طبيعية ، واذا اردت ان تنادي هذه الدالة للحقل abc في نموذجك ، فترسل الحقل الى الدالة ، هكذا : me.abc = Remove_Extras(me.abc) او اذا اردت تعدل الحقل abc وتحفظ البيانات الصافية في الحقل zxc me.zxc = Remove_Extras(me.abc) او اذا اردت ان تضعه في استعلام zxc: Remove_Extras([abc]) جعفر

السلام عليكم 🙂 استبدل هذه الدالة بالدالة الموجودة عندك مسبقا : Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) If Len(x(j)) < 2 Then Else Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function جعفر

انا لا احبذ هذه الفكرة ، وفي الدورات اللي اعملها ، امنع تلامذتي من الدخول في اليوتيوب لمشاهدة الدروس التعليمية. اليوتيوب مفيد للمبرمج الذي يعرف ما يريده بالضبط ، ويستطيع ان يستخلص الفائدة منه ، فقط ، وإلا للمبتدئ ، فاليوتيوب عبارة عن مستنقع ضحل !! كم وكم شاهدنا بعض الاعضاء يسأل السؤال هنا في المنتدى ، وبين ليلة وضحاها نرى انه قد عمل درس لهذا الموضوع على اليوتيوب ، وكم وكم شاهدنا من الدروس على اليوتيوب لمبرمجين اصلا لا يلتزمون بأساسيات البرمجة (وابسطها ان تكون الحقول والكائنات باللغة الانجليزية ، وبكلمات غير محجوزة للأكسس) !! بينما الانترنت مليئ بمنتديات عريقة ، سواء الاجنبية منها او العربية ، وبكل فخر ، فمنتدى اوفسينا احدها ، ولا ابالغ اذا قلت ، اهمها 🙂 جعفر

بالفعل تقديم جميل يبرز طاقة الاكسس في العرض ، والباقي يعتمد على خيال المبرمج 🙂 جعفر

1. ممتاز 🙂 2. اذا التقرير اشتغل بطريقة صحيحة بعد التعديل ، فهذا دليل ان عملك تمام 🙂 3. ان شاء الله الآن اعمل على طلبك 🙂 جعفر