Sub replace_txt()
Dim s As Shape
ActiveDocument.BeginCommandGroup "rep"
from$ = InputBox("Чё меняем?")
tto$ = InputBox("На чё меняем?")
For Each s In ActiveLayer.Shapes.FindShapes(, cdrTextShape)
s.Text.Story = rep(s.Text.Story, from, tto)
Next s
ActiveDocument.EndCommandGroup
End Sub
Private Function rep(s As String, pat As String, reptxt As String) As String
rep = s
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.IgnoreCase = True
're.MultiLine = True
re.MultiLine = False
re.Pattern = pat
If re.Test(s) Then
rep = re.replace(s, reptxt)
End If
End Function