Каждый TextRange имеет коллекцию Runs. Если весь текст в диапазоне одинаково отформатирован, в коллекции будет только один прогон.
Если шрифт / размер / цвет / жирность изменяется в середине потока, коллекция Runs будет увеличиваться.
Доступ к каждому прогону в коллекции дает вам TextRange, свойства шрифта которого вы можете проверить. Предположим, например, что у вас есть такой текст (все в одной форме)
Этот текст отформатирован одинаково.
Этот текст включает в себя немного текста, выделенного жирным шрифтом .
Sub thing()
Dim oSh As Shape
Dim oRng As TextRange
Dim x As Long
Dim y As Long
' Assume that the shape with your text is selected
Set oSh = ActiveWindow.Selection.ShapeRange(1)
' You can look at the text in the shape as a whole,
' or paragraph by paragraph or line by line or character by character.
' Let's do it para by para
With oSh.TextFrame.TextRange
For x = 1 To .Paragraphs.Count
With .Paragraphs(x)
Debug.Print "Paragraph: " & x
For y = 1 To .Runs.Count
Debug.Print vbTab & "Run: " & y
Debug.Print .Runs(y).Font.Bold
Next
End With
Next
End With
End Sub
Абзац: 1 Прогон: 1 0 Абзац: 2 Прогон: 1 0 Прогон: 2 -1 Прогон: 3 0
Первый абзац имеет 1 прогон только потому, что весь текст отформатирован одинаково.
0 = НЕ выделен жирным шрифтом.
Во втором абзаце есть 3 прогона (по одному на каждый символ, отформатированный иначе, чем предыдущий). NotBold, BOLD, NotBold