اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

'
' سطران أو صفان أولهما متشابه
'
'
   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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information