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.
Wiki hinweis.png

Anmerkung: Die Funktion kann nur in einer Vollversion von Access verwendet werden, weil in der Runtime-Version von Access das WizHook-Objekt nicht vorhanden ist.


Public Function TextBreiteUndHoehe(Schriftart As String, _
                                   ByVal Schriftgroesse As Long, _
                                   Text As String, _
                                   ByVal dx As Long, _
                                   ByVal dy As Long, _
                                   Optional ByVal Bold As Boolean, _
                                   Optional ByVal Italic As Boolean, _
                                   Optional ByVal Underline As Boolean) As Boolean
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   '-------------------------------------------------------------------------------
   '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          Schriftgroesse 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)
   '
   'Wenn lngCch <> 0:
   '• strCaption wird ignoriert, lngCch = Anzahl der Zeichen,
   '• lngMaxWidthCch = Anzahl Zeichen mit maximaler Breite,
   '• lngCch minus lngMaxWidthCch = Anzahl Zeichen mit durchnittlicher Breite
   '-------------------------------------------------------------------------------
 
   Dim Weight As Long
 
   If Bold Then
      Weight = 700
   Else
      Weight = 400
   End If
 
   With WizHook
      .Key = 51488399
      TextBreiteUndHoehe = .TwipsFromFont(Schriftart, Schriftgroesse, _
                                          Weight, Italic, _
                                          Underline, 0, Text, 0, _
                                          dx, dy)
   End With
End Function

Aufruf

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

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


Wiki hinweis.png

Anmerkung: Tests haben ergeben, dass die TwipsFromFont-Funktion offensichtlich etwas zu kleine Werte liefert. Das könnte daran liegen, dass 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.


Wikilinks

Weblinks