Vba kullanarak altyazı metni hizalamasını tek bir tuş üzerinde değiştirmek mümkün mü?

Question

Bu yüzden aşağıdaki kodu ve "rbtn" için yaratılan düğmeyi kullanıyorum. Altyazının üst yüzüne sarmak ya da hizalamak için altyazı metninin alt yüzünü zorlamak istiyorum (böylelikle sarılıyor). Sorun şu ki, düğmedeki resim yazısı kullanıcının girdiği her şey olabilir ve bunun ne olduğunu bilmeyeceğim. Eğer 4'ten fazla karakterse sarması gerekiyor. Her yere baktım ama bu konuya bir çözüm bulamıyor gibi görünmüyor. Düğme boyutunu değiştirmek tercih edilmez. Metin sarma düğmesinin basitçe yapılmasını düşünürdüm ama bir çözüm bulamıyorum. Biri yardım edebilir mi? Teşekkürler

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

ActiveX düğmeleri gibi form denetimleri için WordWrap yoktur. Genişliği ayarlamak için bir Otomatik Boyutlandırma yöntemi vardır, ancak uygun yüksekliği elde etmek için satır sonlarını elle eklemeniz gerekir. Bu kod, her 4. karakterden sonra satır sonu ekleyecektir:

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