Schriftarten auslesen
19.09.2006 08:52:17
André
35.000 Fonts bekommen, die auf einem anderen Verzeichnis (M) liegen und
die ich bei Bedarf akti- und deaktivieren kann.
Sub SchriftartenLesen()
Dim CBC As CommandBarControl
Dim iCnt As Integer, strTxt As String
Application.ScreenUpdating = False
strTxt = InputBox("Testtext:", "")
If strTxt = "" Then Exit Sub
Set CBC = Application.CommandBars.FindControl(ID:=1728)
For iCnt = 1 To CBC.ListCount
With Cells(iCnt, 1)
.Value = strTxt
.Font.Name = CBC.List(iCnt)
End With
Cells(iCnt, 2) = CBC.List(iCnt)
Next iCnt
Columns("A:B").AutoFit
Application.ScreenUpdating = True
End Sub
Mit freundlichen Grüßen
André Poppek