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

Is it possible to change the caption text alignment on a button using vba?

所以我有下面的代码,对于为 "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

没有像 ActiveX 按钮那样用于表单控件的 WordWrap。有一个用于设置宽度的 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