Starter1, к сожалению, моих идей недостаточно.
На простом тексте, наподобие Вашего первого поста в этой теме, хорошо работает такое:
читать дальше »
Код:
Option Explicit
Sub Sample2()
Dim objRegExp As Object
Dim lngValue As Long
Dim intOrder As Integer
Dim strValue As String
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = "(?:1\d{4,}|[2-9]\d{4,}),?\d*"
Do While objRegExp.Test(ThisDocument.Range.Text)
With objRegExp.Execute(ThisDocument.Range.Text).Item(0)
lngValue = CLng(Replace(.Value, ",", "."))
intOrder = ((Len(CStr(lngValue)) - 1) \ 3) * 3
strValue = CStr(lngValue \ 10 ^ intOrder) & "·10"
Debug.Print .Value
With ThisDocument.Range(.FirstIndex, .FirstIndex + .Length)
Debug.Print .Information(wdActiveEndPageNumber) & " (" & .Information(wdNumberOfPagesInDocument) & ")"
.Delete
.InsertAfter strValue
.Collapse wdCollapseEnd
.InsertAfter intOrder
.Font.Superscript = True
.Collapse wdCollapseEnd
End With
End With
Loop
Set objRegExp = Nothing
End Sub
Но, при наличии в документе полей, нумерация символов в «ThisDocument.Range()» и «ThisDocument.Range.Text» не совпадает.
Также, насколько я понимаю, не удастся перевести шаблон регулярного выражения в форму для Find & Replace Microsoft Word даже в Вашей версии (
Find and replace text by using regular expressions (Advanced) - Word - Office.com).
Возможно, более опытные коллеги подскажут, что можно сделать.