Текстовое поле (TextBox) - Изменение высоты и ширины полей в зависимости от содержимого

По материалам: http://www.cyberforum.ru/ms-access/thread1607172.html
Основание: https://social.msdn.microsoft.com/Forums/en-US/2727e4a4-57a3-4e4d-a20a-314464579ad3/how-to-calculate-the-width-of-a-access-form-textbox-pending-on-font-and-length-of-characters-string?forum=isvvba

Код из примера:

Private Sub Form_Current()
Dim s$

    s = "One," & vbNewLine & "Two," & vbNewLine & "Three," & vbNewLine & "Four, Five:" & vbNewLine & "Bunny went for a walk."
    Me!txt = s
 
    Me!imja = "Имя ... (Допишите сами!)"
    
    s = "One, Two, Three, Four, Five:" & vbNewLine & "Bunny went for a walk."
    Me!fam = s
    
    s = "One, Two, Three, Four, Five: " & "Bunny went for a walk."
    Me!otch = s
    
    Me!txt.SetFocus
    txt_Change
    
    Me!fam.SetFocus
    fam_Change
    
    Me!imja.SetFocus
    imja_Change
    
    Me!otch.SetFocus
    otch_Change
   
End Sub

Private Sub fam_Change()
    AutoFitControl Me!fam
End Sub
Private Sub imja_Change()
    AutoFitControl Me!imja
End Sub
Private Sub otch_Change()
    AutoFitControl Me!otch
End Sub
Private Sub txt_Change()
    AutoFitControl Me!txt
End Sub

Модуль:

' ------------------------------------------------------
' Name: modAutoFitControl
' Kind: Module
' Purpose: Изменение высоты и ширины полей в зависимости от содержимого
' Author: es
' Date: 23.06.2019
' ------------------------------------------------------
Option Compare Database
Option Explicit

Private Const iHeightOneStr% = 270 'высота одной строки

Public Function GetTextLength(pCtrl As Control, ByVal str As String, _
        Optional ByVal Height As Boolean = False)
    Dim lx As Long, ly As Long
    ' Initialize WizHook
    WizHook.Key = 51488399
    ' Populate the variables lx and ly with the width and height of the
    ' string in twips, according to the font settings of the control
    WizHook.TwipsFromFont pCtrl.FontName, pCtrl.FontSize, pCtrl.FontWeight, _
                          pCtrl.FontItalic, pCtrl.FontUnderline, 0, _
                          str, 0, lx, ly
    If Not Height Then
        GetTextLength = lx
    Else
        GetTextLength = ly
    End If
    
    'Debug.Print "Ширина в твипах: " & lx
    'Debug.Print "Высота в твипах: " & ly
End Function


Public Sub AutoFitControl(ctl As Control)
Dim iRet%
Dim lngWidth As Long
Dim s$
    s = LongestTextInStr(ctl.Text)
    iRet = TotalInStr(ctl.Text, vbCrLf) + 1 'кол-во переводов строки
    lngWidth = GetTextLength(ctl, s)
    ctl.Width = lngWidth + 140
    If iRet > 0 Then
        ctl.Height = iRet * iHeightOneStr + 20
    End If
End Sub

Public Function TotalInStr(sStringWhere As String, sStringWhat As String) As Integer
'Кол-во вхождений одной строки внутри другой
Dim TestPos%

    On Error GoTo TotalInStr_Error

    TestPos = 1

    Do While InStr(TestPos, sStringWhere, sStringWhat) > 0
        TotalInStr = TotalInStr + 1
        TestPos = InStr(TestPos, sStringWhere, sStringWhat) + Len(sStringWhat)
    Loop

    
    On Error GoTo 0
    Exit Function

TotalInStr_Error:
    TotalInStr = 0
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure TotalInStr, line " & Erl & "."

End Function
Public Function LongestTextInStr(sStringWhere As String) As String
'самый длинный текст абзаца (между переводами строк)
Dim i%, iLen%, iLenMax%, s$
Dim vArr As Variant

On Error GoTo LongestTextInStr_Error
    
    vArr = Split(sStringWhere, vbCrLf)
    For i = LBound(vArr) To UBound(vArr)
        'Debug.Print vArr(i)
        s = vArr(i) & ""
        iLen = Len(s)
        If iLen > iLenMax Then
            iLenMax = iLen
            LongestTextInStr = s
        End If
    Next i

    
    On Error GoTo 0
    Exit Function

LongestTextInStr_Error:
    
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure LongestTextInStr, line " & Erl & "."

End Function

MSA-2003 ( 31 kB) Пример