excelvba

How to align texts to the left and right side of TextBox

1) Please run the following code.

    Sub Macro1()
    
    'Add a TextBox
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=100, Height:=100)
        .TextFrame2.TextRange.Text = "Name:" & vbNewLine & "Surname:" & vbNewLine & "Place of Birth:" & vbNewLine & "Age:"
        .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
    End With
    
    'Add a TextBox
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=120, Top:=10, Width:=100, Height:=100)
        .TextFrame2.TextRange.Text = "Michael" & vbNewLine & "Jordan" & vbNewLine & "NewYork" & vbNewLine & "52"
        .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignRight
    End With
            
    End Sub

2) Please check if you have the following TextBoxes in your Excel sheet.

Picture1

3) I am looking for a macro which produce the following TexBox for me.

Picture2

4) As you can understand that this question is regarding formating of alignment of text to the left and right side of TextBox.

Solution

  • Paragraph Formatting, such as Horizontal Alignment is on a per-line (or, rather, a per-paragraph) basis. You cannot apply different Horizontal Alignments to different words in the same Paragraph.

    However, you can change the TextRange to contain more than one Column: this means that text can only occupy a fraction of the Shape, but when lines reach the bottom of the shape they will Wrap around and start another Column. This allows you to have multiple lines, and even different paragraphs, that are vertically aligned to each other!

    Option Explicit 'Warn us if we forget to define a variable.

Sub Macro1()
    Dim i As Long 'Define the variable, so that we don't get a warning
    
    'Delete all shapes
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next i
    
    Dim lLines As Long
    'Add a TextBox
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=200, Height:=100)
        'Start with 1 column, so that we can measure the height properly
        .TextFrame2.Column.Number = 1
        'Add text for the first column
        .TextFrame2.TextRange.Text = "Name:" & vbNewLine & "Surname:" & vbNewLine & "Place of Birth:" & vbNewLine & "Age:"
        
        'Add Line Breaks until you reach the second column
        While .TextFrame2.TextRange.BoundHeight < (.Height - (.TextFrame2.MarginTop + .TextFrame2.MarginBottom))
            .TextFrame2.TextRange.InsertAfter vbNewLine
        Wend
        'Store the number of lines in the first column
        lLines = .TextFrame2.TextRange.Lines.Count
        'Change the shape to have two columns
        .TextFrame2.Column.Number = 2
        
        'Add text for the second column
        .TextFrame2.TextRange.InsertAfter "Michael" & vbNewLine & "Jordan" & vbNewLine & "New York" & vbNewLine & "52"
        
        'Set the Alignment of the first column to Left
        .TextFrame2.TextRange.Lines(1, lLines).ParagraphFormat.Alignment = msoAlignLeft
        'Set the Alignment of the second column to Right
        .TextFrame2.TextRange.Lines(lLines + 1, .TextFrame2.TextRange.Lines.Count - lLines).ParagraphFormat.Alignment = msoAlignRight
    End With
End Sub

    By splitting the text across two columns, you can set the alignment of the lines in each column independently.

    As a bonus, you can also expand this to three or more columns, such as for a "Left / Centre / Right" version too:

    Sub Macro2()
    Dim i As Long 'Define the variable, so that we don't get a warning
    
    'Each element in the Array represents one column
    Dim TextArray As Variant
    TextArray = Array("Name" & vbNewLine & "Surname" & vbNewLine & "Place of Birth" & vbNewLine & "Age", _
        ":" & vbNewLine & ":" & vbNewLine & ":" & vbNewLine & ":", _
        "Michael" & vbNewLine & "Jordan" & vbNewLine & "New York" & vbNewLine & "52")
    
    'Delete all shapes
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next i
    
    Dim lLines As Long, lColumns As Long, Alignment As MsoParagraphAlignment
    'Add a TextBox
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=200, Height:=100)
        'Start with 1 column and not text, so that we can measure the height properly
        .TextFrame2.Column.Number = 1
        .TextFrame2.TextRange.Text = ""
        'Add New Lines until the Column is Full
        While .TextFrame2.TextRange.BoundHeight < (.Height - (.TextFrame2.MarginTop + .TextFrame2.MarginBottom))
            .TextFrame2.TextRange.InsertAfter vbNewLine
        Wend
        'Store the number of lines per column
        lLines = .TextFrame2.TextRange.Lines.Count
        'Reset the text
        .TextFrame2.TextRange.Text = ""
        
        lColumns = 0
        'Add text and count columns
        For i = LBound(TextArray) To UBound(TextArray)
            'Start new column
            lColumns = lColumns + 1
            'Add text for the current column
            .TextFrame2.TextRange.InsertAfter TextArray(i)
        
            'If there are more columns
            If i < UBound(TextArray) Then
                'Add Line Breaks until the next column is reached
                While .TextFrame2.TextRange.Lines.Count < lLines * lColumns
                    .TextFrame2.TextRange.InsertAfter vbNewLine
                Wend
            End If
        Next i
        'Change the shape to have multiple columns
        .TextFrame2.Column.Number = lColumns
        
        For i = 1 To lColumns
            'You can decide the Alignment some other way if you prefer
            Select Case i
                Case 1: 'First Column: Align Left
                    Alignment = msoAlignLeft
                Case lColumns: 'Last Column: Align Right
                    Alignment = msoAlignRight
                Case Else: 'All other columns: Align Center
                    Alignment = msoAlignCenter
            End Select
            
            'Set the alignment for the column
            If i < lColumns Then
                .TextFrame2.TextRange.Lines(1 + (lLines * (i - 1)), lLines).ParagraphFormat.Alignment = Alignment
            Else
                'The last column can have fewer lines than the rest
                .TextFrame2.TextRange.Lines(1 + (lLines * (i - 1)), .TextFrame2.TextRange.Lines.Count - (lLines * (i - 1))).ParagraphFormat.Alignment = Alignment
            End If
        Next i
    End With
End Sub