【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