Tipp 0427 Installierte Schriftarten mit Vorschau anzeigen
Autor/Einsender:
Datum:
  Angie
27.12.2004
Entwicklungsumgebung:   Excel 2000
Mit diesem Beispiel lassen sich die im entsprechenden Office-Programm zur Verfügung stehenden Schriftarten ermitteln. Diese werden in einer ComboBox aufgelistet, können ausgewählt und als Vorschau in einer TextBox angezeigt werden.
In Word kann für das Auflisten der installierten Schriftarten auch das FontNames-Objekt verwendet werden, siehe dazu Tipp Word - Schriftarten auflisten.
 
Option Explicit

Private Sub UserForm_Initialize()
  Dim avarFonts As Variant
  Dim avarArray As Variant
  Dim strText   As String

  avarFonts = GetFontsList
  With Me.cboFontNames
    .Clear
    If IsArray(avarFonts) Then
      .List = avarFonts
      Erase avarFonts
      .ListIndex = 0
    Else
      Call DisableControls
      Exit Sub
    End If
  End With

  avarArray = Array(8, 9, 10, 11, 12, 14, 16, 18, 20, 24, 28, 36)
  With Me.cboFontSize
    .Clear

    .ColumnCount = 1
    .ColumnWidths = "10"
    .ListWidth = 36

    .List = avarArray
    .Text = "14"
  End With

  strText = "abcdefghijklmnopqrstuvwxyz "
  Me.txtPreview.Text = UCase$(strText) & vbCr & LCase$(strText)
End Sub

Private Function GetFontsList() As Variant
  Dim cbrBar    As CommandBar
  Dim cbcFont   As CommandBarControl

  Dim avarFonts As Variant
  Dim nCnt      As Long

  On Error GoTo err_GetFonts

  Set cbcFont = Application.CommandBars.FindControl(ID:=1728)
  If cbcFont Is Nothing Then
    Set cbrBar = Application.CommandBars.Add( _
          "MyDummy", msoBarFloating, False, True)
    Set cbcFont = cbrBar.Controls.Add(ID:=1728)
  End If

  ReDim avarFonts(1 To cbcFont.ListCount)
  For nCnt = 1 To cbcFont.ListCount
    avarFonts(nCnt) = cbcFont.List(nCnt)
  Next
  If IsArray(avarFonts) Then
    GetFontsList = avarFonts
  End If

err_GetFonts:
  If Not cbrBar Is Nothing Then cbrBar.Delete
  Set cbrBar = Nothing
  Set cbcFont = Nothing
  On Error GoTo 0
End Function

Private Function DisableControls()
  Dim ctl As Control

  For Each ctl In Me.Controls
    ctl.Enabled = False
  Next

  With Me.cmdClose
    .Enabled = True
    .Default = True
  End With
End Function

Private Sub cboFontNames_Click()
  With Me.txtPreview.Font
    .Name = Me.cboFontNames.Text
    .Charset = 2
  End With
End Sub

Private Sub cboFontSize_Change()
  Me.txtPreview.Font.Size = Val(Me.cboFontSize.Text)
End Sub

Private Sub chkBold_Click()
  Me.txtPreview.Font.Bold = Me.chkBold.Value
End Sub

Private Sub chkItalic_Click()
  Me.txtPreview.Font.Italic = Me.chkItalic.Value
End Sub
 
Hinweis
Die im Download befindliche *.frm-Datei kann für Word und PowerPoint im jeweiligen Programm im VB-Editor importiert werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Anwendung/VBA-Version
Access 97
Access 2000
Access XP
Access 2003
Access 2007
Access 2010
Excel 97
Excel 2000
Excel XP
Excel 2003
Excel 2007
Excel 2010
Word 97
Word 2000
Word XP
Word 2003
Word 2007
Word 2010
PPT 97
PPT 2000
PPT XP
PPT 2003
PPT 2007
PPT 2010
Outlook 97
Outlook 2000
Outlook XP
Outlook 2003
Outlook 2007
Outlook 2010


Download  (23,8 kB) Downloads bisher: [ 760 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 19. Juni 2011