إدراج رقم صفحة مسلسل مع رقم جزء يتم اختياره بين معقوفين على صورة [1/5]

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

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

ومعلوم أن كتابة الأرقام بشكل متكرر لا يخلو من خطأ.

فهذا الماكرو يقوم بكتابة رقم الجزء والصفحة في الموضع الذي تحدده بين معقوفين على صورة [1/5]، [1/6]، وهكذا، ويمكن أن تغير رقم الجزء فيصبح [2/5]، [2/6] وهكذا.

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

' إدراج رقم جزء وصفحة بين معقوفين في الموضع الحالي
'
'
    Dim ss, a As Integer
    Selection.TypeText Text:="^"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "/<[0-9]@>\]"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
     Selection.Find.Execute
  
       If Selection.Find.Found = False Then
       ss = InputBox("أدخل رقم الجزء", , "1")
 
If ss = False Then
Exit Sub
Else
End If
    Selection.TypeBackspace
    Selection.TypeText Text:="[" & ss & "/]"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1

 Else
 
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
  
    a = Val(Selection.Text)
   
    Selection.MoveLeft Unit:=wdWord, Count:=1
    Selection.MoveLeft Unit:=wdWord, Count:=3, Extend:=wdExtend
    b = Selection.Text
    Selection.MoveRight Unit:=wdWord, Count:=3

    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^"
        .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
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=b
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="]"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^"
        .Replacement.Text = ""
        .Forward = False
        .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
    Selection.TypeText Text:=Val(a) + 1
    Selection.MoveRight Unit:=wdCharacter, Count:=2
 
End If
Beep
End Sub