שיתוף | קוד VBA להמיר בוורד ממספרים לאותיות

[מגדלים]

שלום חברים, אשמח לשתף את הציבור עם קוד שנצרכתי לזה בעבר.
מיועד לטקסטים מלאים בוורד מחולק לפי פרקים ממוספרים מ-1 עד למעלה מ-100 , ורוצים להפוך את הכל לאותיות למשל 1-א 11-י"א וכו'
הקוד רלוונטי לכל סוגי ההחלפות של מספרים לאותיות, וע"כ יש להיזהר באם קיימים בטקסט עוד מספרים שלא יהפכו לאותיות.. וד"ל.
שימו לב! אם המספור בוצע באמצעות המספור האוטומטי של וורד ניתן להחליף הכל בבת אחת בהגדרות המספור.

Sub המרת_מספרים_לאותיות()
start:
With Selection.Find
    .ClearFormatting
    .Execute findText:="[0-9]{1,}", MatchWildcards:=True, Format:=False, Wrap:=wdFindContinue
    If .Found = True Then
S = ""

MyArray = Array(400, 300, 200, 100, 90, 80, 70, 60, 50, 40, 30, 20, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
MyaArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", _
"י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
V = Val(Selection)
Do While V > 0
If V = 15 Or V = 16 Then
S = S & "ט"
V = V - 9
End If
  For i = 0 To UBound(MyArray)
    If V >= MyArray(i) Then
      S = S & MyaArray(i)
      V = V - MyArray(i)
      Exit For
    End If
  Next i
Loop

Selection = S

GoTo start
    End If
End With
End Sub

מקור.
אין בזה מרכאות בין האותיות. וכן אינה מסודרת ללשון נקיה אבל התוכן קיים!
אבל כן מחליף ב15 לטו וכו'.
נ.ב. לא יתאים למספור עמודים.
בהצלחה.

[מגדלים]

והנה להוספה ללשון נקיה, וכן להוסיף מרכאות בין האותיות...

Sub המרה()
start:
With Selection.Find
    .ClearFormatting
    .Execute findText:="[0-9]{1,}", MatchWildcards:=True, Format:=False, Wrap:=wdFindContinue
    If .Found = True Then
S = ""

MyArray = Array(400, 300, 200, 100, 90, 80, 70, 60, 50, 40, 30, 20, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
MyaArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", _
"י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
V = Val(Selection)
Do While V > 0
If V = 15 Or V = 16 Then
S = S & "ט"
V = V - 9
End If
  For i = 0 To UBound(MyArray)
    If V >= MyArray(i) Then
      S = S & MyaArray(i)
      V = V - MyArray(i)
      Exit For
    End If
  Next i
Loop

If S = "רצח" Then S = "רחצ"
If S = "רע" Then S = "ער"
If S = "רעב" Then S = "ערב"
If S = "שד" Then S = "דש"
If S = "שמד" Then S = "שדמ"
If S = "תשמד" Then S = "תדשם"
If S = "רעה" Then S = "ערה"
If S = "רעד" Then S = "עדר"

If Len(S) = 1 Then
    S = S & "'"
Else
    S = Left(S, (Len(S) - 1)) & Chr(34) & Right(S, 1)
End If

Selection = S

GoTo start
    End If
End With
End Sub