Thema Datum  Von Nutzer Rating
Antwort
05.07.2006 17:55:35 Florian
NotSolved
Blau Aw:Schriftart über eine Userform wählen.
 06.07.2006 03:30:09 Manni
NotSolved

Ansicht des Beitrags:
Von:
Manni		 Datum:
06.07.2006 03:30:09		 Views:
1914		 Rating:
     
Antwort:
  Ja
Thema:
Aw:Schriftart über eine Userform wählen.
Hi Florian,

folgendes habe ich bei www.vb-fun.de gefunden:
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

vielleicht hilfts ja

gruß
manni

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.07.2006 17:55:35 Florian
NotSolved
Blau Aw:Schriftart über eine Userform wählen.
 06.07.2006 03:30:09 Manni
NotSolved