【CorelDraw VBA 006例】 在指定段落中查找字体

Private Sub FindFontsInRange(ByVal tr As TextRange, ByVal col As Collection)
    '##查找字体
    Dim FontName As String
    Dim trBefore As TextRange, trAfter As TextRange
    If Not tr Is Nothing Then
        FontName = tr.Font
        If FontName = "" Then
            ' There are more than one font in the range
            ' Divide the range in two and look into each half separately
            ' to see if any of them has the same font. Repeat recursively
            Set trBefore = tr.Duplicate
            trBefore.End = (trBefore.Start + trBefore.End) \ 2
            Set trAfter = tr.Duplicate
            trAfter.Start = trBefore.End
            FindFontsInRange trBefore, col
            FindFontsInRange trAfter, col
        Else
            AddFontToCollection FontName, col
        End If
    End If
End Sub