Finding if a TextBox/Label caption fits in the control - vba

Question

The scenario is trying to adjust font size to get a nice graphic arrangement, or trying to decide where to break a caption/subtitle.
a) In XL VBA is there a way to find out whether a text on a textbox, or caption on a label, still fits the control?
b) Is there a way to know where was the text/caption broken on multiline control?

Answer 1

I gave this a rest, gave it enough back-of-head time (which produces far better results than "burp a non-answer ASAP, for credits"), and...
Function TextWidth(aText As String, Optional aFont As NewFont) As Single
Dim theFont As New NewFont
Dim notSeenTBox As Control
On Error Resume Next 'trap for aFont=Nothing
theFont = aFont 'try assign
If Err.Number Then 'can't use aFont because it's not instantiated/set
theFont.Name = "Tahoma"
theFont.Size = 8
theFont.Bold = False
theFont.Italic = False
End If
On Error GoTo ErrHandler
'make a TextBox, fiddle with autosize et al, retrive control width
Set notSeenTBox = UserForms(0).Controls.Add("Forms.TextBox.1", "notSeen1", False)
notSeenTBox.MultiLine = False
notSeenTBox.AutoSize = True 'the trick
notSeenTBox.Font.Name = theFont.Name
notSeenTBox.SpecialEffect = 0
notSeenTBox.Width = 0 ' otherwise we get an offset (a ""feature"" from MS)
notSeenTBox.Text = aText
TextWidth = notSeenTBox.Width
'done with it, to scrap I say
UserForms(0).Controls.Remove ("notSeen1")
Exit Function
ErrHandler:
TextWidth = -1
MsgBox "TextWidth failed: " + Err.Description
End Function
I feel I'm getting/got close to answer b), but I'll give it a second mind rest... because it works better than stating "impossible" in a flash.

Answer 2

I'm sure there is no way to do this with the ordinary Excel controls on the Forms toolbar, not least because (as I understand it) they are simply drawings and not full Windows controls.
The simplest approach may be to make a slightly conservative estimate of the maximum text length for each control, through a few tests, and use these to manage your line breaks.

Answer 3

This can be achieved by taking advantage of the label or textbox's .AutoSize feature, and looping through font sizes until you reach the one that fits best.
Public Sub ResizeTextToFit(Ctrl As MSForms.Label) 'or TextBox
Const FONT_SHRINKAGE_FACTOR As Single = 0.9 'For more accuracy, use .95 or .99
Dim OrigWidth As Single
Dim OrigHeight As Single
Dim OrigLeft As Single
Dim OrigTop As Single
With Ctrl
If .Caption = "" Then Exit Sub
.AutoSize = False
OrigWidth = .Width
OrigHeight = .Height
OrigLeft = .Left
OrigTop = .Top
Do
.AutoSize = True
If .Width <= OrigWidth And .Height <= OrigHeight Then
Exit Do 'The font is small enough now
.Font.Size = .Font.Size * FONT_SHRINKAGE_FACTOR
.AutoSize = False
Loop
.AutoSize = False
.Width = OrigWidth
.Height = OrigHeight
.Left = OrigLeft
.Top = OrigTop
End With
End Sub