Как заменить сложные правила в слове на VBA

Question

Я пытаюсь заменить некоторое число с фиксированной точкой в ​​процентном выражении в текстовом документе, например:

0.1234 -> 12.3%

Я написал следующий код

Sub DoReplace()
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "0.[0-9]*^13"
        .Replacement.Text = Str(Val("^&") * 100) + "%" + "^13"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Я думаю ^& означает исходную строку выбора, поэтому я могу выполнить какое-то преобразование, но здесь это не работает.

Answer 1

Вы не можете сделать математику таким образом в Найти / Заменить. В любом случае вам не нужно:

Sub DoReplace()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Format = False
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Text = "0.([0-9]{2})([0-9][0-9])@^13"
    .Replacement.Text = "\1.\2%^p"
    .Execute Replace:=wdReplaceAll
    .Text = "0.([0-9]{2})([0-9])^13"
    .Replacement.Text = "\1.\20%^p"
    .Execute Replace:=wdReplaceAll
    .Text = "0([0-9].[0-9]@%)"
    .Replacement.Text = "\1"
    .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

Вышеописанный процесс усекает вывод в 2 знака после десятичной точки. Для округления вывода требуется нечто более сложное:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "0.[0-9]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Format = False
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .End = .End - 1
    .Text = Format(.Text, "0.00%")
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub