صفان أو فقرتان أولهما متطابق:

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

نحتاج كثيرا إلى اختبار أوائل صفوف الجداول أو أوائل الفقرات للبحث عن التكرار، سواء أكان تكرار كلمتين أو ثلاثة أو أكثر، وهذا ماكرو يفيدك في ذلك:

'
' سطران أو صفان أولهما متشابه
'
'
   On Error Resume Next
    Dim sPrompt As String
    Dim sUserResp As String
    Dim iUR As Integer
    sPrompt = "1. بداية صفين متشابهة [جدول]" & vbCrLf
    sPrompt = sPrompt & "2. بداية فقرتين متشابهة [فقرات]" & vbCrLf
    
    iUR = 0 '''''''''''''''''
    While iUR < 1 Or iUR > 3
        sUserResp = InputBox(sPrompt, "اختر واحدًا مما يلي")
        iUR = Val(sUserResp)
        ''''''''''''''''' لإمكانية إلغاء جميع الاختيارات وقفل الكود
        If iUR = False Then
Exit Sub
End If
''''''''''''''''''''''
    Wend
    Select Case iUR
        
  Case 1
  If Selection.Information(wdWithInTable) = False Then
    MsgBox ("ضع المؤشر داخل الجدول")
    Exit Sub
  Else
 End If
   ss = InputBox("أدخل عدد الكلمات التي تريد مقارنتها في أول الصف")
   Do
       
    Selection.MoveRight Unit:=wdWord, Count:=ss, Extend:=wdExtend
    a = Selection.Text
    Selection.HomeKey Unit:=wdLine
    Selection.GoTo what:=wdGoToLine, Which:=wdGoToNext, Count:=1, name:=""

    Selection.MoveRight Unit:=wdWord, Count:=ss, Extend:=wdExtend
 b = Selection.Text
If a = b Then
Beep
If MsgBox("سجلان أولهما مكرر، هل ترغب في المتابعة؟", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
End If
Selection.HomeKey Unit:=wdLine
Loop Until (Selection.End = ActiveDocument.Content.End - 1)
Beep

  Case 2
  If Selection.Information(wdWithInTable) = True Then  ''' إذا كان المؤشر داخل جدول فتوقف عن العمل
    MsgBox (" لا يصلح هذا الاختيار داخل الجدول، اختر رقم 2 ")
    Exit Sub
  Else
 End If
    ss = InputBox("أدخل عدد الكلمات التي تريد مقارنتها في أول الفقرة")
    Do
    Selection.MoveRight Unit:=wdWord, Count:=ss, Extend:=wdExtend
    a = Selection.Text
    Selection.MoveDown Unit:=wdParagraph, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=ss, Extend:=wdExtend
     b = Selection.Text
If a = b Then
Beep
If MsgBox("فقرتان أولهما مكرر، هل ترغب في المتابعة؟", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
End If
Selection.HomeKey Unit:=wdLine
Loop Until (Selection.End = ActiveDocument.Content.End - 1)
End Select
Beep
End Sub

[تومي محمد]

شكرا جزيلا