AutoSizeCaption




Private Sub AutoSizeCaption(lbl As Label)
Dim iAs Integer
Dim iLabelWidth As Integer
Dim sTextAs String
Const kMore = "..."
'store orignal caption and width

sText = lbl.Caption
'numeric or date? Don't format.

If IsNumeric(lbl.Caption) Or IsDate(lbl.Caption) Then Exit Sub
iLabelWidth = lbl.Width
'allow label to "spring" to it's actual width

lbl.AutoSize = True
'is required width of label < actual width?


If lbl.Width > iLabelWidth Then
i = Len(sText) - 1
Do
lbl.Caption = Left(sText, i) & kMore
i = i - 1
Loop Until (lbl.Width <= iLabelWidth) Or (i = 0)
End If

Exit_Sub:
lbl.AutoSize = False
lbl.Width = iLabelWidth
Exit Sub
ErrorHandler:
'something went wrong ... put everything back

lbl.Caption = sText
Resume Exit_Sub
End Sub










( autosizecaption.html )- by Paolo Puglisi - Modifica del 17/12/2023