كود حذف الأسطر الفارغة والمسافات في أول السطر

[nssj]

الإخوة الكرام .. ماهو الكود الذي يقوم بحذف الأسطر الفارغة سواء في بداية الحقل أو أثنائه

وكذلك كود حذف المسافة أو المسافات التي تكون في بداية الأسطر

أسطر.accdb

[أبو عبدالله الحلوانى]

لحذف المسافات الموجودة أول النص وآخره استخدم الدالة trim 

وتكتب هكذا

Trim("Youer text")

 

[nssj]

الأخ الكريم (أبو عبد الله) لم أعرف أن أستخدم هذه الدالة على حقل النص، فالرجاء تطبيقه على الملف المرفق

ويبقى موضوع: حذف الأسطر الفارغة

[jjafferr]

السلام عليكم 🙂

 

استبدل هذه الدالة بالدالة الموجودة عندك مسبقا :

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

 

جعفر

[nssj]

وعليكم السلام ورحمة الله وبركاته أخي الكريم جعفر .. وبارك الله فيك

لكن إذا تكرمت أنا بحاجة لهذا الكود منفصلاً عن كود التحويل من وورد.

أي أني بحاجة لهذا الكود لاستخدامه بين الحين والآخر على أي نموذج في أي قاعدة بيانات، كل المطلوب من مبتدئ مثلي حينها تغيير اسم النموذج أو الجدول في زر تنفيذ الكود

وهي عملية أقوم بها بين الحين والآخر لمعالجة ظهور هذه المسافات والأسطر الفارغة نتيجة عمليات القص واللصق المتكررة والمتعددة من هنا وهناك، فضلا عن احتمال وجودها بالخطأ عند الكتابة السريعة ونحو ذلك .. فهي أشبه بعملية تشطيب (سوبر ديلوكس) بعد ورشة عمل عنيييييفة ☺️

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

 

[jjafferr]

51 دقائق مضت, nssj said:

أنا بحاجة لهذا الكود منفصلاً عن كود التحويل من وورد.

اعمل وحدة نمطية جديدة ، واحفظها لاحقا بإسم mod_Remove_Extras ، والصق الدالة اعلاه في هذ الوحدة النمطية ، ثم احذف الدالة القديمة من برنامجك (هذه الخطوة مهمة حتى لا يتكرر سم الدالة مرتين في برنامجك) ،

كودك القديم سيعمل بطريقة طبيعية ،

واذا اردت ان تنادي هذه الدالة للحقل abc في نموذجك ، فترسل الحقل الى الدالة ، هكذا :

me.abc = Remove_Extras(me.abc)

او اذا اردت تعدل الحقل 
abc
وتحفظ البيانات الصافية في الحقل
zxc

me.zxc = Remove_Extras(me.abc)

او اذا اردت ان تضعه في استعلام
zxc: Remove_Extras([abc])

 

جعفر

[nssj]

الأخ المكرم جعفر .. صبرك علي شوي .. وخليك معي خطوة بخطوة سلمك الله .. فيظهر أني لم أصل بعد إلى مرتبة: مبتدئ 🤔

أولا: هل لابد من وحدة نمطية .. ألا يمكن أن يقوم الكود بالعمل بدونها ؟

ثانيا: بالتطبيق على الملف المرفق حسب فهمي المتواضع، ظهر لي أن الكود يعمل على السجل الموجود انا فيه فقط، والمطلوب أن يعمل على كل الملف

ثم وبمجرد ان أضع المؤشر على خانة النص تعود المسافات في أول الأسطر

فيظهر أني أم أفهم الدرس جيداً 🙄

أسطر2.accdb

[SEMO.Pa3x]

عليكم السلام، تفضل:

 

Dim RegExp As Object
Set RegExp = CreateObject("VBScript.RegExp")

With RegExp
    .MultiLine = True
    .Global = True
    .Pattern = "(\r\n)+"

    resultString = .Replace(nass, vbCrLf)
    nass = resultString
    
End With

SplitCatcher = Split(nass, vbCrLf)

For Counter = 0 To UBound(SplitCatcher)

    If Right(SplitCatcher(Counter), 1) = " " Then
    
       SplitCatcher(Counter) = Right(SplitCatcher(Counter), 1)

    End If
    
Next

 

[jjafferr]

5 ساعات مضت, nssj said:

أولا: هل لابد من وحدة نمطية .. ألا يمكن أن يقوم الكود بالعمل بدونها ؟

ثانيا: بالتطبيق على الملف المرفق حسب فهمي المتواضع، ظهر لي أن الكود يعمل على السجل الموجود انا فيه فقط، والمطلوب أن يعمل على كل الملف

ثم وبمجرد ان أضع المؤشر على خانة النص تعود المسافات في أول الأسطر

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

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

 

ويكون افضل اذا تجعل الحقل ID يكون عليه التركيز ، بحيث تغير اعداداتع الى صفر :

 

 

12 دقائق مضت, SEMO.Pa3x said:

Dim RegExp As Object Set RegExp = CreateObject("VBScript.RegExp")

حيا الله الدكتور 🙂

الكود لا يحذف الاسطر الفارغة اذا كانت اول السطر او بين الاسطر !!

 

جعفر

[nssj]

الإخوة الكرام .. الظاهر أن وضعي أصعب مما ظننت 😪

جربت الكود الذي تفضل به الأخ أبو مهاب ولم يحدث شيئ

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

ثم يظهر لي بخصوص حذف المسافات في بداية السطر أنه يحذف مسافة واحدة فقط

والرجاء من أهل الخبرة مراعاة وضعي الصعب وإجراء اللازم على الملف وإعادة رفعه تلافيا لسوء فهمي أو تصرفي

[jjafferr]

انت عامل نموذج فردي ، فطبيعي يتغير السجل اللي انت عليه فقط ،

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

 

 

أسطر2.accdb

[nssj]

الأخ الكريم جعفر .. تم المطلوب بخصوص الأسطر الفارغة

لكن .. هل هذا الكود يعمل أيضا على حذف المسافات في بداية ونهاية السطر .. فلم ألاحظ أنه حذفها

[biskra]

بواسطة استعلام مثل الذي قدمه الأستاذ جعفر قم بنسخة و عدله بالتالي و جرب

UPDATE مسند SET مسند.nass = Replace(nass," ","");

 

[nssj]

أخي الكريم .. هذا الكود قلب الملف رأسا على عقب  🙃 وألغى كل المسافات 😂

[Hawiii]

لم أجرب أكواد الأساتذة ، ولكن من خلال المشاهدة كود الأخ جعفر يبدو لي صحيحا.
عموما جرب هذا الكود:
 

Sub CleanTable(Table As String, Field As String)
  DoCmd.RunSQL "UPDATE " & Table & " SET [" & Table & "].[" & Field & "] = Trim([" & Field & "]);"
  DoCmd.RunSQL "UPDATE " & Table & " SET [" & Table & "].[" & Field & "] = Replace([" & Field & "],'" & Chr(10) & "','');"
  DoCmd.RunSQL "UPDATE " & Table & " SET [" & Table & "].[" & Field & "] = Replace([" & Field & "],'" & Chr(13) & "','');"
End Sub

'لاستدعاء كود تنظيف الجدول
Private Sub CmdCleanTable_Click()
  Call CleanTable("سند", "nass")
End Sub

 

[SEMO.Pa3x]

10 ساعات مضت, jjafferr said:

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

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

 

ويكون افضل اذا تجعل الحقل ID يكون عليه التركيز ، بحيث تغير اعداداتع الى صفر :

 

 

حيا الله الدكتور 🙂

الكود لا يحذف الاسطر الفارغة اذا كانت اول السطر او بين الاسطر !!

 

جعفر

 

حيا الله اصلك يامعلم،

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

[nssj]

الأخ الكريم Hawiii .. جربت استخدام الكود فلم أفلح .. سواء لوحده أم باستعلام أم مع وحدة نمطية 🙄

وأود أن أذكرك بأن وضعي صعب جداً .. ولم أصل بعد لدرجة مبتدئ .. ومصطلحات: وحدة نمطية .. واستدعاء الكود .. والتحويل لاستعلام .. مصطلحات لم أستطع تطبيقها إلى الآن

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

[biskra]

أخي الكريم أولا معذرة عن الكود و ما سببه له لك من خلط،

الملاحظ من النص أن المسافات التي أزعجتك بعد تنفيذ كود الأخ جعفر، في الحقيقة هي صحيحة لأنك لو سحبت المسافة بين بداية السطر يدويا بعد تنفيذ الكود سوف تلاحط أن الكلمة سوف تلتصق بما قبلها، و لاحظت كذلك أن تنسيق النص يأخذ مسافة واحدة في سطر جديد بعد نهاية الفقرة السابقة بنقطة ربما هذا مرجعه الى تحرير النص أساس بالوورد، و لاحظ كذلك أن النص عند نهاية السطر بفاصلة فإنه لا يأخذ أي مسافة فارغة من بداية السطر،و على كل جرب طباعة الحقل بعد تنفيذ الكود و سوف تتضح لك الأمور،

 

{214}
{{217}}
 عن طلق بن حبيب، عن أَنس بن مالك، قال: قال رسول الله صَلى الله عَليه وسَلم: «ثلاث من كن فيه وجد بهن حلاوة الإيمان وطعمه: أن يكون الله، عز وجل، ورسوله أحب إليه مما سواهما، وأن يحب في الله، وأن يبغض في الله، وأن توقد نار عظيمة فيقع فيها، أحب إليه من أن يشرك بالله شيئا».
 أخرجه أحمد 3/ 207 (13184) و3/ 278 (14005) قال: حدثنا روح، قال: حدثنا شعبة. و «النَّسَائي» 8/ 94 قال: أخبرنا إسحاق بن إبراهيم، قال: أنبأنا جرير.
 كلاهما (شعبة، وجرير بن عبد الحميد) عن منصور بن المعتمر، عن طلق بن حبيب، فذكره.

في الملف المرفق تجد تجربة أخرى لكود حذف المسافات في أي مكان دون التأثير على النص، جرب إضافة مسافات في مكان من النص في جميع السجلات ثم نفد الاستعلام و سوف ترى النتيجة، الكود لا يزيل السطر الفارغ.

أسطر2(ReduireEspaces).rar

[nssj]

الأخ الكريم biskra .. الكود الذي تفضلت به يحذف المسافات المكررة خلال النص، ولم ألاحظ أنه حذف المسافات أول وآخر السطر، وهي المطلوبة

ثم بصراحة .. الموضوع يزداد تشعبا بالنسبة لمبتدئ مثلي بينما كنت أظن أنه أيسر من ذلك .. وأنا خايف يصير وضعي أصعب من الصعب 🙄

تم تعديل يناير 24, 2021 بواسطه nssj

[jjafferr]

تفضل:

تم اضافة :

        '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

 

جعفر

[Hawiii]

دالة
Trim()
تؤدي وظيفة دالتي:
LTrim()
و
RTrim()
مجتمعتين.

تم تعديل يناير 24, 2021 بواسطه Hawiii

[nssj]

الأخ الكريم جعفر .. تم الأمر بحمد الله فجزاك الله خيراً

مع ملاحظة أن الكود لم يحذف المسافات التي في آخر السطر .. وربما لأنني لم أطلب ذلك في بداية الموضوع 🙂 .. ولكن الأمر هين ولا أريد أن أعقد الأمر أكثر من ذلك

ثم وأنا أجري التجارب وبعد تقليب النظر بين الأكواد السابقة اخترعت استعلامين، أحدهما لحذف المسافة في بداية السطر 

UPDATE مسند SET nass = Replace(nass,Chr(13)+" ",Chr(13));

والثاني لحذف المسافة في آخر السطر 

UPDATE مسند SET nass = Replace(nass," "+Chr(13),Chr(13));

طبعا .. هو يحذف مسافة واحدة فقط .. ولكن هذا بالنسبة لي إنجاز كبييير 🙂 .. وحتى في الوورد الذي أعمل عليه منذ سنين أنا أقوم بهذا الأمر بنفس الطريقة تقريبا .. أستمر بعملية الاستبدال أكثر من مرة لحذف جميع المسافات والأسطر الزائدة

ولكن -وإن كان طلبا جانبيا خارج الموضوع- كيف يمكنني إدماج مثل هذين الاستعلامين في استعلام واحد .. لعلي أستخدم هذا الأمر في استعلامات أخرى

[jjafferr]

اخي nssj

لا انصحك بالخلط بين الاكواد ، فمنها سيكون متكرر ، فيعمل بطئ في برنامجك ،

وتستطيع ان تضعه هنا ، ليقوم الاعضاء بتصحيحه 🙂

 

 

منذ ساعه, Hawiii said:

دالة
Trim()
تؤدي وظيفة دالتي:

LTrim()
و
RTrim()
مجتمعتين.

حيا الله اخوي الهاوي 🙂

نعم اعرف هذا ، ولكن لم تنجح التجربه به !!

تفضل هذا المرفق ، ولاحظ المسافات حسب ما اوضحتها ، جرب واخبرنا 🙂

.

واتضح ان كودي يحتاج الى تعديل ليحل هذه الاشكاليه كذلك :

        '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

[nssj]

الأخ الكريم جعفر .. الأكسس الذي عندي لم يعجبه السطر الذي أضفته وأخرج لي رسالة وظلله بالأصفر

ولما قلت له تابع على أي حال .. غضب وحذف كل شيء 😂

خلينا عالكود الأول أحسن 🙂

[Hawiii]

هناك 3 حروف/رموز
(المسافة) وقيمة الآسكي لها 32 وإزالتها بدالة Trim
و (سطر جديد) والآسكي له 13 + 10 ويمكن إزالته بدالة Replace إما رمز رمز (على دفعتين) كما مثالي أو إثنينهما مجتمعين على دفعة واحدة.

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