Question

所以我有下面的代码和为“rbtn”创建的按钮我想要强制按钮面上的标题文本将其包裹或对齐到顶部垂直（因此它包装）。我遇到的问题是按钮上的标题可以是用户输入的内容，我不知道这是什么。如果它超过4个字符则需要换行。我看过每个地方，但似乎无法找到解决这个问题的方法。更改按钮大小不是首选。我认为按钮上的文本换行会很简单，但我似乎无法找到解决方案。有人可以帮忙吗？感谢

Sub AddRoute()
Dim x As Integer
Dim bc As String
bc = "*"
x = ThisWorkbook.Sheets.Count
If x > 9 Then Call SndClm
If x > 9 Then End
Dim btn As Button
Dim rbtn As Button
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim t As Range
Dim g As Range
Dim sName As String
Dim wks As Worksheet
j = ThisWorkbook.Sheets.Count
i = ThisWorkbook.Sheets.Count
Worksheets("NewRoute").Copy After:=Sheets(Worksheets.Count)
Set wks = ActiveSheet
Do While sName <> wks.Name
    sName = Application.InputBox _
      (Prompt:="Enter new route name")
    On Error Resume Next
    wks.Name = sName
    Worksheets("Home").Activate
    On Error GoTo 0
    i = i + j
    x = i + j
    ActiveSheet.Cells(x - 4, 7).Select
    Set g = ActiveSheet.Range(Cells(1, 7), Cells(2, 7))
    Set rbtn = ActiveSheet.Buttons.Add(ActiveCell.Left, ActiveCell.Top, g.Width, g.Height)
    ActiveSheet.Cells(x - 4, 8).Select
    Set t = ActiveSheet.Range(Cells(1, 8), Cells(2, 10))
    Set btn = ActiveSheet.Buttons.Add(ActiveCell.Left, ActiveCell.Top, t.Width, t.Height)

    With rbtn
    .Font.Name = "Calibri"
    .Font.Size = 11
    .OnAction = "'btnS""" & sName & """'"
    .Caption = sName
    .Name = sName
    End With

    With btn
    .Font.Name = "free 3 of 9"
    .Font.Size = 36
    .OnAction = "'btnS""" & sName & """'"
    .Caption = bc + sName + bc
    .Name = sName
    End With



    Application.ScreenUpdating = True
Loop
Set wks = Nothing
ActiveSheet.Cells(1, 1).Select
End Sub

Answer 1

表单控件没有WordWrap，就像ActiveX按钮一样。有一个AutoSize方法用于设置宽度，但您仍需要手动添加换行符以获得正确的高度。此代码将在每第4个字符后添加换行符：

Dim g As Range
Dim rbtn As Button
Dim sName As String
Dim sNewName As String

sName = Application.InputBox(Prompt:="Enter new route name")
While Len(sName) > 4
    sNewName = sNewName & Left(sName, 4) & vbNewLine
    sName = Mid(sName, 5, 10000000)
    'This assumes the names won't be longer than 10 million characters
Wend
'Pick up that last bit that is under 4 characters
sNewName = sNewName & sName
Stop

ActiveSheet.Cells(4, 7).Select
Set g = ActiveSheet.Range(Cells(1, 7), Cells(2, 7))
Set rbtn = ActiveSheet.Buttons.Add(ActiveCell.Left, ActiveCell.Top, g.Width, g.Height)

With rbtn
    .AutoSize = True
    .Font.Name = "Calibri"
    .Font.Size = 11
    .Caption = sNewName
End With

是否可以使用vba更改按钮上的标题文本对齐方式？

1 个答案: