עלה לי רעיון:
על ידי זיהוי גודל לא זהה מצו"ב
Private Sub SizeReplacements()
Dim defaultSize As Integer, currentSize As Integer, diff As Integer, i As Integer
Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
' קבלת גודל הפונט ברירת המחדל
defaultSize = normalStyle.Font.SizeBi
' שלב 1: סימון גודל הפונט ברירת המחדל
With ActiveDocument.Content.Find
.style = normalStyle
.Format = True
.Font.SizeBi = defaultSize
.Replacement.text = "»^&«"
.Execute Replace:=wdReplaceAll
End With
' שלב 2: הוספת תגיות מותאמות לגודל
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=1
With Selection.Find
.style = normalStyle
.Format = True
.ClearFormatting
.text = "«[!»^13]{1,}"
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute
Call Trim
If Selection.style = normalStyle Then
'זיהוי טווח עם גדלים שונים
If Selection.Font.SizeBi = 9999999 Then
Call DivideTextByFontSize
GoTo nxt
End If
'זיהוי טקסט גדול\קטן
currentSize = Selection.Font.SizeBi
If currentSize > defaultSize Then
'סימון טקסט גדול
diff = currentSize - defaultSize
For i = 1 To diff
Selection.InsertBefore "<big>"
Selection.InsertAfter "</big>"
Next i
ElseIf currentSize < defaultSize Then
'סימון טקסט קטן
diff = defaultSize - currentSize
For i = 1 To diff
Selection.InsertBefore "<small>"
Selection.InsertAfter "</small>"
Next i
End If
End If
Selection.Collapse (wdCollapseEnd)
nxt:
Loop
End With
' שלב 3: הסרת המהדורים
With ActiveDocument.Content.Find
.text = "[»«]"
.MatchWildcards = True
.Replacement.text = ""
.Execute Replace:=wdReplaceAll
End With
End Sub
Private Sub DivideTextByFontSize()
With Selection
Do While .Font.SizeBi = 9999999
.MoveEnd wdCharacter, -1
Loop
.InsertAfter "»«"
.MoveStart wdWord, -1
.Collapse (wdCollapseStart)
End With
End Sub