Mit Word-Makro alle Schriften anzeigen

Probetext von allen installierten Schriften

Sub SchriftenGeneratorI()
  Probetext = "Franz jagt im komplett verwahrlosten Taxi quer durch Bayern. 0123456789"
  Set rDoc = Documents.Add
  System.Cursor = wdCursorWait
  Application.ScreenUpdating = False
  Selection.TypeText "Name" & vbTab & "Schriftprobe" & vbCrLf
  For Each Schrift In Application.FontNames
    With Selection
      .Font.Name = "Arial"
      .Font.Size = 10
      .TypeText Text:=Schrift & vbTab
      .Font.Name = Schrift
      .TypeText Text:=Probetext & vbCrLf
    End With
  Next
  With Selection
    .WholeStory
    .ConvertToTable Separator:=wdSeparateByTabs, _
       Format:=wdTableFormatProfessional, AutoFit:=True
    .Sort ExcludeHeader:=True
    .ParagraphFormat.SpaceBefore = 2
    .ParagraphFormat.SpaceAfter = 2
    .HomeKey Unit:=wdStory
    .SplitTable
    .Style = wdStyleHeading1
    .TypeText Text:="Schriftproben"
    .EndKey Unit:=wdStory
    .Style = wdStyleNormal
    .HomeKey Unit:=wdStory
  End With
  Application.ScreenUpdating = True
  System.Cursor = wdCursorNormal
  Set oAssistant = Assistant
  If Not oAssistant Is Nothing Then
    Assistant.Animation = msoAnimationCharacterSuccessMajor
  End If
  Set oAssistant = Nothing
End Sub

Alle Zeichen mit allen Schriften

Sub SchriftenGeneratorII()
  For i = 21 To 255
    Probetext = Probetext & Chr(i)
  Next i
  Set rDoc = Documents.Add
  System.Cursor = wdCursorWait
  Application.ScreenUpdating = False
  Selection.TypeText "Name" & vbTab & "Schriftprobe" & vbCrLf
  For Each Schrift In Application.FontNames
    With Selection
      .Font.Name = "Arial"
      .Font.Size = 10
      .TypeText Text:=Schrift & vbTab
      .Font.Name = Schrift
      .TypeText Text:=Probetext & vbCrLf
    End With
  Next
  With Selection
    .WholeStory
    .ConvertToTable Separator:=wdSeparateByTabs, _
       Format:=wdTableFormatProfessional, AutoFit:=True
    .Sort ExcludeHeader:=True
    .ParagraphFormat.SpaceBefore = 2
    .ParagraphFormat.SpaceAfter = 2
    .HomeKey Unit:=wdStory
    .SplitTable
    .Style = wdStyleHeading1
    .TypeText Text:="Schriftproben"
    .EndKey Unit:=wdStory
    .Style = wdStyleNormal
    .HomeKey Unit:=wdStory
  End With
  Application.ScreenUpdating = True
  System.Cursor = wdCursorNormal
  Set oAssistant = Assistant
  If Not oAssistant Is Nothing Then
    Assistant.Animation = msoAnimationCharacterSuccessMajor
  End If
  Set oAssistant = Nothing
End Sub

Siehe auch

• Mit Word-Makro Sonderzeichen nach HTML umwandeln
• Mit Word-Makro alle Schriften anzeigen
• Hyperlink in geschützten Word-Dokumenten