Ist es möglich, die Ausrichtung der Textausrichtung auf einer Schaltfläche mithilfe von vba zu ändern?

Question

Also habe ich den Code unten und für die Taste, die für "rbtn" erstellt wird, möchte ich entweder den Text der Beschriftung auf der Schaltfläche Fläche zu umbrechen oder an der Spitze vertikal ausgerichtet (so dass es umschließt). Das Problem, das ich habe, ist, dass die Beschriftung auf der Schaltfläche sein kann, was auch immer der Benutzer eingibt, und ich werde nicht wissen, was das ist. Wenn es mehr als 4 Zeichen ist, muss es umbrochen werden. Ich habe überall nachgesehen, aber ich finde keine Lösung für dieses Problem. Das Ändern der Schaltflächengröße wird nicht bevorzugt. Ich würde denken, dass der Text-Wrap auf dem Button einfach wäre, aber ich kann einfach keine Lösung finden. Kann jemand helfen? Danke

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

Es gibt kein WordWrap für Formularsteuerelemente, wie es für ActiveX-Schaltflächen gibt. Es gibt eine Methode AutoSize zum Festlegen der Breite, aber Sie müssen immer noch manuell Zeilenumbrüche hinzufügen, um die richtige Höhe zu erhalten. Dieser Code fügt einen Zeilenumbruch nach jedem 4. Zeichen hinzu:

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