【CorelDraw VBA 005例】 列出文档中的字体

Sub ListDocumentFonts()
    '##列出文档中的字体
    Dim p As Page
    Dim s As Shape
    Dim col As New Collection
    Dim sFontList As String
    Dim vFont As Variant
    For Each p In ActiveDocument.Pages
        For Each s In p.FindShapes(, cdrTextShape)
            FindFontsInRange s.Text.Frame.Range, col
        Next s
    Next p
    sFontList = ""
    For Each vFont In col
        If sFontList <> "" Then sFontList = sFontList & vbCrLf
        sFontList = sFontList & vFont
    Next vFont
    ActiveDocument.Pages(1).ActiveLayer.CreateParagraphText 0, 0, 3, 8, sFontList, Font:="Arial", Size:=10
End Sub