AW: Schrifttypen auslesen und in eine Mappe schreiben.
ypsilon
hi Marco,
ähh : was soll ivd. heissen ?
so in etwa ?
Sub Schriftartenliste()
Dim SchriftNr As Integer, Schriftliste As Object
Set Schriftliste = Application.CommandBars("formatting").FindControl(ID:=1728)
On Error Resume Next
ScreenUpdating = False
[A:C].ClearContents
For SchriftNr = 0 To Schriftliste.ListCount - 1
Cells(SchriftNr + 1, 1).Value = Schriftliste.List(SchriftNr + 1)
Cells(SchriftNr + 1, 2).Value = "abcdefghijklmnopqrstuvwxyzäöü"
Cells(SchriftNr + 1, 3).Value = "ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
Cells(SchriftNr + 1, 2).Font.Name = Schriftliste.List(SchriftNr + 1)
Cells(SchriftNr + 1, 3).Font.Name = Schriftliste.List(SchriftNr + 1)
Next
[A:C].EntireColumn.AutoFit
ScreenUpdating = True
End Sub
cu Micha