VBA Tipp: Breite und Höhe eines Textes ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte die Breite und die Höhe eines Textes (Strings) ermitteln, um z.B. die Breite und die Höhe eines Text-Steuerelements an die Textgröße anzupassen.

Lösung

  • Das geht mit der folgenden Funktion, die in einem globalen Modul hinterlegt wird.
  • Die Funktion verwendet das (undokumentierte) WizHook-Objekt, das es seit Access 2000 gibt.
  • In der Funktion wurden nur die wichtigsten Parameter des WizHook-Objekts verwendet. Sie könnte aber noch um zusätzliche Schriftattribute erweitert werden: Fett, kursiv, unterstrichen
Public Function TextbreiteUndHöhe(ByVal Schriftart As String, _
                                  ByVal Schriftgröße As Long, _
                                  ByVal Text As String, _
                                  ByRef dx As Long, _
                                  ByRef dy As Long _
                                  ) As Boolean
 
 'Quelle: http://www.dbwiki.net/
 
 '-------------------------------------------------------------------------------
 'Erklärung der Parameter der Funktion TwipsFromFont
 
 'Function WizHook.TwipsFromFont(FontName As String, Size As Long, Weight As Long, _
                         Italic As Boolean, Underline As Boolean, Cch As Long, _
                         Caption As String, MaxWidthCch As Long, dx As Long, _
                         dy As Long) As Boolean
 
 'FontName      Name der Schriftart
 'Size          Schriftgröße in Punkten
 'Weight        Schriftbreite: 400 = normal, 700 = fett, usw.
 'Italic        True = kursiv, False = nicht kursiv
 'Underline     True = unterstrichen, False = nicht unterstrichen
 'Cch           Anzahl an Zeichen mit durchschnittlicher Breite
 'Caption       Text (String), für den die Breite und Höhe bestimmt werden soll
 'MaxWidthCch   Anzahl an Zeichen mit maximaler Breite
 'dx            Ermittelte Breite des Textes in Twips (ByRef)
 'dy            Ermittelte Höhe des Textes in Twips (ByRef)
 '-------------------------------------------------------------------------------
 
 Dim lngWeight As Long
 Dim bolItalic As Boolean
 Dim bolUnderline As Boolean
 Dim lngCch As Long
 Dim strCaption As String
 Dim lngMaxWidthCch As Long
 Dim lngdx As Long
 Dim lngdy As Long
 
 lngWeight = 400
 bolItalic = False
 bolUnderline = False
 lngCch = 0
 lngMaxWidthCch = 0
 lngdx = 0
 lngdy = 0
 
 'Wenn lngCch ungleich 0:
 '• strCaption wird ignoriert, lngCch = Anzahl der Zeichen,
 '• lngMaxWidthCch = Anzahl Zeichen mit maximaler Breite,
 '• lngCch minus lngMaxWidthCch = Anzahl Zeichen mit durchnittlicher Breite
 
 WizHook.Key = 51488399
 TextbreiteUndHöhe = WizHook.TwipsFromFont(Schriftart, Schriftgröße, _
                                           lngWeight, bolItalic, _
                                           bolUnderline, lngCch, Text, _
                                           lngMaxWidthCch, dx, dy)
 
End Function

Aufruf

Der Rückgabewert der Funktion ist "True", wenn kein Fehler aufgetreten ist, ansonsten "False".

 Dim strSchriftart As String
 Dim lngSchriftgröße As Long
 Dim lngTextbreite As Long
 Dim lngTexthöhe As Long
 Dim strMeldung As String
 
 strSchriftart = "Arial"
 lngSchriftgröße = 8
 strMeldung = "Mein Text"
 
 Call TextbreiteUndHöhe(strSchriftart, lngSchriftgröße, strMeldung, _
                        lngTextbreite, lngTexthöhe)
 
 '567 Twips = 1 cm
 MsgBox "Textbreite: " & lngTextbreite & " Twips" & vbCrLf & _
        "Texthöhe: " & lngTexthöhe & " Twips"


Wiki hinweis.png Anmerkung: Tests haben ergeben, daß die TwipsFromFont-Funktion offensichtlich etwas zu kleine Werte liefert. Das könnte daran liegen, daß die Funktion aus dem Jahr 2000 stammt, und die Schriftarten in Windows immer wieder einmal an neue Normen angepasst werden. Als Korrektur müssen daher zu den gelieferten Breiten- und Höhenangaben einige Prozent Aufschlag hinzugerechnet werden.


Wiki-Links

Web-Links