Platzbedarf für Text ermitteln

Gelegentlich möchte man Steuerelemente in Formularen und Berichten an den tatsächlich von ihnen benötigten Platz anpassen. Access liefert keine offizielle Funktion, um für einen gegebenen Text mit einer bestimmten Schriftgröße und -breite den Platzbedarf in Höhe und Breite zu liefern. Grund genug, auf eine nicht dokumentierte Funktion zuzugreifen und diese entsprechend zu wrappen …

Die versteckte Wizhook-Klasse liefert immer wieder nützliche Funktionen (siehe auch Shortlink 358). Gleichwohl sind diese Funktionen mit Vorsicht zu genießen, denn diese Klasse mit ihren Elementen ist nicht dokumentiert und könnte in zukünftigen Versionen von Access einfach verschwinden. Doch wie das Beispiel der MsgBox-Funktion beim Wechsel von Access 97 zu Access 2000 zeigt, haben auch dokumentierte VBA-Funktionen nicht unbedingt den Anspruch, für alle Ewigkeiten gleich zu arbeiten.

Also ran an die nützlichen Diener der Wizhook-Klasse, in diesem Fall die Funktion TwipsFromFont. Diese wird von der Funktion GetTextSize gekapselt, sodass die Eingabe der Parameter und das Auswerten des Ergebnisses etwas leichter als mit dem Original fällt – außerdem berücksichtigt diese Funktion auch Zeilenumbrüche (s. Listing 1).

Listing 1: Die Funktion GetTextSize ermittelt die Abmessungen von Texten in Abhängigkeit von deren Inhalt, der Schriftgröße, der Schriftart und weiteren Eigenschaften.

Function GetTextSize(strText As String, FontName As String, FontSize As Long, _
    Optional IsBold As Boolean, Optional IsItalic As Boolean) As TSize
    Dim H As Long, W As Long, WMax As Long
    Dim vText() As String
    Dim n As Long, i As Long
    On Error GoTo Fehler
    WizHook.Key = 51488399
    vText = Split(strText, vbCrLf)
    n = UBound2(vText)
    For i = 0 To n
        WizHook.TwipsFromFont FontName, FontSize, 400 + (IsBold * 300), IsItalic, _
        False, 0, vText(i), 0, W, H
        If W > WMax Then WMax = W
    Next i
    GetTextSize.y = H * (n + 1)
    GetTextSize.x = WMax
    Ende:
    Exit Function
    Fehler:
    MsgBox "Fehler-Nr: " & Err & vbcrlf & "Fehler-Beschreibung: " & Err.Description
    Resume Ende
End Function

Sie haben das Ende des frei verfügbaren Textes erreicht. Möchten Sie ...

Workplace

Jahresabonnement TestzugangOder haben Sie bereits Zugangsdaten? Dann loggen Sie sich gleich hier ein:

Schreibe einen Kommentar