Question

该方案试图调整字体大小以获得漂亮的图形排列，或者尝试决定在哪里打破字幕/副标题。 a）在XL VBA中，有没有办法找出文本框上的文字或标签上的标题是否仍适合控件？ b）有没有办法知道多行控制中的文本/标题在哪里被破坏？

Answer 1

我给了它一个休息时间，给了它足够的后头时间（产生了比“尽快打嗝非答案，获得积分”更好的结果），以及......

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

我觉得我已接近/接近回答b），但我会给它留下第二个心灵休息......因为它比在瞬间说“不可能”更好。

Answer 2

我确信无法使用“表单”工具栏上的普通Excel控件执行此操作，尤其是因为（据我所知）它们只是绘图而不是完整的Windows控件。

最简单的方法可能是通过一些测试对每个控件的最大文本长度进行略微保守的估计，并使用它们来管理换行符。

Answer 3

这可以通过利用标签或文本框的 .AutoSize 功能来实现，并循环使用字体大小，直到找到最适合的字体大小。

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

查找TextBox / Label标题是否适合控件

3 个答案: