سؤال للإخوة خبراء عمل الماكرو في الورد عن أمر آخر كلمة في الملف

[أبو عاصم المصري]

الإخوة الأفاضل خبراء عمل ماكرو في الورد، هل هناك أمر معين معناه: نفّذ العملية من هنا إلى آخر كلمة في الملف؟

أو: إذا وصلت إلى آخر كلمة في الملف فتوقف، وذلك على غرار:

 ..............For i = 1 To

أو

 If Selection....... = False Then end

[أ / محمد صالح]

يمكن استخدام

For I = 1 to ActiveDocument.Words.count

بالتوفيق 

[أبو عاصم المصري]

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

[أبو عاصم المصري]

عفوا أستاذ محمد، ومعذرة لإثقالي عليك...

أريد أيضا:

أمر: إذا وصلت إلى آخر الملف توقَّف

على غرار:

if ..........then end

[أ / محمد صالح]

الحلقة التكرارية تتوقف مع نهاية عدد كلمات المستند 

[أبو عاصم المصري]

هناك خيار في الماكرو يحدد عدد الكلمات المراد تشكيلها، وخيار آخر لعدد مرات التنفيذ.

بمعنى أن تختار أن يقوم الماكرو بتشكيل (5) كلمات أو (4)، أو (3) مثلا متتالية.

والخيار الثاني: أن يكرر هذه العملية في الملف مثلا (100) مرة، أو (200) مرة، وهكذا.

والمطلوب هو:

أمر: إذا وصلت العمليات إلى آخر كلمة في الملف يجب التوقف.

فكرة الماكرو كالتالي:

1- فتح ملف كبير مشكول بالكامل.

2- فتح الملف المراد تشكيله.

3- نقوم بتشغيل الماكرو.

4- نختار عدد الكلمات المراد تشكيلها (5)، أو (4)، أو (3)، أو (2).

5- نختار عدد مرات التنفيذ (100)، أو (200) مثلا.

6- يقوم الماكرو بنسخ كلمتين  أو ثلاثة مثلا حسب الاختيار.

7- يذهب إلى الملف المشكول ويبحث فيه عن هذه الكلمات مجتمعة.

8- إذا وجدها نسخها، ثم رجع إلى الملف المراد تشكيله وقام بعملية استبدال الكل، بحيث يستبدل كل الكلمات غير المشكولة بالمشكولة.

9- ثم يرجع خطوة، ثم يتحرك إلى الكلمة أو الكلمات التالية وتظليلها ونسخها.

10- الانتقال إلى الملف المشكول، وإجراء العملية السابقة.

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

12- كل هذا مع تلوين الكلمات المستبدلة باللون الأحمر لتمييزها.

* الإشكال أنني عندما أصل إلى آخر صفحات في الملف، لا أعرف عدد مرات التكرار، فقد يكون عدد الكلمات مثلا (100)، وأنا طلبت منه أن ينفذ العملية (200) مرة، فيستمر في إعادة العمليات على الكلمات نفسها.لذا طلبت منك أخانا الحبيب أمرا ليوقف الماكرو إذا وصل إلى آخر الملف.ولك مني أطيب التحيات

* ملحوظة:

وضعت هذا السطر : If Len(Selection.Text) < 2 Then End

بعد سطر تحديد الكلمات المراد تشكيلها، ليقف الماكرو إذا وجد المظلل أقل من حرفين، لكنه للأسف يوقف الماكرو عن علامات التنصيص «، »، [،]، (،)

 

[أبو عاصم المصري]

شكرا أخي محمد، توصلت لحل المشكلة، والأمر هو:

If (Len(Selection.Text) - 2 > 0) Then

والماكرو في صورته النهائية:

Sub تشكيلآلي()
' تشكيلآلي Macro
'ماكرو يشكل كلمات ملف من ملف آخر مشكول، بشرط فتح الملفين في آن واحد، وعند تشغيل الماكرو تختار عدد الكلمات المراد تشكيلها، كما تختار عدد مرات تكرار ذلك في الملف'
      Dim x, a, b, c As Integer
      k = InputBox("اكتب عدد الكلمات + 1")
   x = InputBox("اكتب عدد مرات التنفيذ")
       For i = 1 To x
             
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
         If (Len(Selection.Text) - 2 > 0) Then
               If Selection.Find.Found = False Then
    Windows(2).Activate
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdWord, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=k, Extend:=wdExtend
    a = Selection.Text
          
            Windows(1).Activate
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
        With Selection.Find
        .Text = a
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
        If Selection.Find.Found = False Then
    Windows(2).Activate
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Else    
    b = Selection.Text
       Windows(2).Activate
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = a
        .Replacement.Text = b
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = True
        .MatchAlefHamza = True
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute replace:=wdReplaceAll
    Selection.MoveRight Unit:=wdWord, Count:=1
End If
End If
Next i
Beep
MsgBox "تم تشكيل الكلمات وتمييزها باللون الأحمر"
End Sub