ترتيب أرقام في فقرة:

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

نحتاج كثيرا إلى ترتيب مجموعة أرقام في فقرة محددة كُتبت بينها فاصلة، لكنها لم يُراع فيها الترتيب، والورد لا يمكن أن يرتب هذه الأرقام إلا إذا كان كل رقم في فقرة.

مثال: ( 52، 25، 526، 528، 29، 530، 631، 532، 33) وهذه الأرقام مرتبة بشكل غير صحيح، ونحن نحتاج إلى ترتيبها لتصبح (  25، 29، 33 ،52، 526، 528، 530، 532)

وإذا أردت ذلك فعليك أولا أن تحدد هذه الأرقام المطلوب ترتيبها، ثم تشغل الماكرو ليقوم بترتيبها.

وهذا الماكرو:

' ماكرو لترتيب أرقام محددة
'بحيث تظلل مجموعة أرقام بينها فاصلة (،) وتشغل الماكرو ليقوم بترتيب هذه الأرقام من الأصغر إلى الأكبر
'
    
   On Error Resume Next
   If Len(Selection.Text) = 1 Then
   MsgBox "من فضلك ظلل الأرقام التي تريد ترتيبها"
   Exit Sub
   Else
   End If
   
   If MsgBox("تنبيه: عند تحديد الأرقام يجب ألا يكون بعد الرقم الأخير مسافة أو فاصلة، أو أي علامة ترقيم، فهل ترغب في المتابعة؟", vbQuestion + vbYesNo) <> vbYes Then
   Exit Sub
   End If
  
    Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Copy
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
   If Selection.Text = Chr(161) Then    ' إذا كان آخر التظليل فاصلة
   ActiveWindow.Close (False)
   MsgBox ")،( لا يصح أن يكون آخر التظليل فاصلة "
   Exit Sub
   Else
   End If
    
  If Selection.Text = Chr(32) Then     ' إذا كان آخر التظليل مسافة
  ActiveWindow.Close (False)
  MsgBox "لا يصح أن يكون آخر التظليل مسافة"
  Exit Sub
   Else
   End If
    
    If Selection.Text = Chr(13) Then   ' إذا كان آخر التظليل مسافة كبيرة
    ActiveWindow.Close (False)
    MsgBox "لا يصح أن يكون آخر التظليل مسافة"
    Exit Sub
    Else
    End If
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "،"
        .Replacement.Text = "^p"
        .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 Replace:=wdReplaceAll
    Selection.Sort ExcludeHeader:=False, FieldNumber:="فقرات", SortFieldType:= _
        wdSortFieldNumeric, SortOrder:=wdSortOrderAscending, FieldNumber2:="", _
        SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:=wdSortOrderAscending _
        , FieldNumber3:="", SortFieldType3:=wdSortFieldAlphanumeric, SortOrder3:= _
        wdSortOrderAscending, Separator:=wdSortSeparateByTabs, SortColumn:=False, _
         CaseSensitive:=False, LanguageID:=wdArabic, SubFieldNumber:="فقرات", _
        SubFieldNumber2:="فقرات", SubFieldNumber3:="فقرات"
    Selection.Sort BidiSort:=False, IgnoreThe:=True, IgnoreKashida:=False, _
        IgnoreDiacritics:=False, IgnoreHe:=False
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "،"
        .Forward = True
        .Wrap = wdFindStop
        .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 Replace:=wdReplaceAll
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    Selection.PasteAndFormat (wdPasteDefault)
    ActiveWindow.Close (False)
    Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Beep
End Sub