TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub ShowMeTheFonts()

    Dim x As Long
    Dim sMsg As String

    With ActivePresentation

        For x = 1 To .Fonts.Count
            With .Fonts(x)

                ' save the name of the font
                sMsg = sMsg & .Name & vbCrLf

                ' Save embeddability information:
                If .Embeddable Then
                    sMsg = sMsg & vbTab _
                        & "Embeddable" & vbCrLf
                    If .Embedded Then
                        sMsg = sMsg & vbTab _
                            & "Embedded" & vbCrLf
                    Else
                        sMsg = sMsg & vbTab _
                            & "but NOT Embedded" & vbCrLf
                    End If
                Else
                    sMsg = sMsg & vbTab _
                        & "NOT embeddable" & vbCrLf
                End If

            End With   ' Font(x)
        Next     ' Font
    End With     ' The presentation

    ' Now show us what we found
    MsgBox sMsg

End Sub