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

Question

So I have the code below and for the button being created for "rbtn" I want to either force the text of the caption on the button face to wrap or align it to the top vertical (so it wraps). The problem I'm having is that the caption on the button can be whatever the user enters and I won't know what this is. If it's more than 4 characters it needs to wrap. I've looked every where but can not seem to find a solution to this issue. Changing the button size is not preferred. I would think making the text wrap on the button would be simply but I just can't seem to find a solution. Can anyone help? Thanks

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

There is no WordWrap for form controls like there is for ActiveX buttons. There is an AutoSize method for setting the width, but you'll still need to manually add line breaks to get the proper height. This code will add a line break after every 4th character:

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