Поиск цифровой последовательности, ее начальной и конечной позиции в тексте шейпа ()

FindNumberInText.md

Код опубликован в ветке обсуждения https://visio.getbb.ru/viewtopic.php?p=16847#p16847

Sub FindNumberInText()
Dim shp As Shape ' переменная текущая фигура
Dim dl As Integer ' переменная длина текстового блока текущей фигуры
Dim symb As String ' текущий символ
Dim sn As Integer ' ASCII-код текущего символа
Dim cr As String ' числовая последовательность в текстовом блоке
Dim st As Integer ' начальная позиция числовой последовательности в текстовом блоке
Dim lng As Integer ' количество символо числовой последовательности в текстовом блоке
Dim NumF As Boolean ' признак наличия числовая последовательность в текстовом блоке
' перебор фигур на листе
For Each shp In ActivePage.Shapes
' очищаем все переменные
cr = "": symb = "": sn = 0: st = 0: lng = 0: NumF = False
' определеляем длину текстового блока
dl = Len(shp.Text)
' посимвольный перебор текста
For i = 1 To dl
' определяем текущий символ
symb = Mid(shp.Text, i, 1)
' определяем ASCII текущего символа
sn = Asc(symb)
  ' является ли текущий символ числом (числу 0 соответствует 48 … числу 9 - 57) !
If sn > 47 And sn < 58 Then
' если предыдущий символ не был числом запоминаем его позицию и включаем признак числа
If Not NumF Then 
st = i: NumF = True
end if
' добавляем число в последовательность
cr = cr & symb
Else
' если текущий символ после предыдущего числа не является числом выходим из режима перебора
If NumF Then Exit For
End If
' переходим к следующему символу
Next
' определяем длину числовой последовательности в тексте фигуры
lng = Len(cr)
' если числовая последовательность имеет ненулевую длину производим замену текста на поле
If lng <> 0 Then
' определяем переменную vchar
Dim vchar As Visio.Characters
Set vchar = shp.Characters
' отлавливаем начала положение начала числовой последовательности           
vchar.Begin = st - 1
' отлавливаем начала положение конца числовой последовательности       
vchar.End = st + lng - 1
' вставляем вместо числовой последовательности поле Prop.Row_1
vchar.AddCustomFieldU "Prop.Row_1", visFmtNumGenNoUnits
End If
' переходим к следующей фигуре
Next
' оповещаем о конце выполнения процедуры
MsgBox "TheEnd!"
End Sub