excel - How to change font color for specific line (row) of Textbox - Stack Overflow

1. Please run the following code.

    Sub Macro1()
   
    'Delete all shapes
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next
   
    'Add a Textbox
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=30, Width:=70, Top:=20, Height:=120)
        .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
        .TextFrame2.TextRange.Text = "Stack" & vbNewLine & "Over" & vbNewLine & "Flow" & vbNewLine & "is" & vbNewLine & "the" & vbNewLine & "best."
    End With
   
    End Sub
   

2. I want to change second line (row) text color from black to red.

3. I want to change fifth line (row) text color from black to blue.

4. The following picture shows desired result.

1. Please run the following code.

    Sub Macro1()
   
    'Delete all shapes
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next
   
    'Add a Textbox
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=30, Width:=70, Top:=20, Height:=120)
        .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
        .TextFrame2.TextRange.Text = "Stack" & vbNewLine & "Over" & vbNewLine & "Flow" & vbNewLine & "is" & vbNewLine & "the" & vbNewLine & "best."
    End With
   
    End Sub
   

2. I want to change second line (row) text color from black to red.

3. I want to change fifth line (row) text color from black to blue.

4. The following picture shows desired result.

• excel
• vba
• colors
• fonts
• shapes

Share Improve this question Follow edited Feb 2 at 23:49 Kram Kramer asked Feb 1 at 8:36 Kram KramerKram Kramer 12111 silver badge66 bronze badges

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 2

There might be a better way, but you can just count keep track of which line you are on based on the count of line feeds:

   Sub Macro1()
    
        For i = ActiveSheet.Shapes.Count To 1 Step -1
            ActiveSheet.Shapes(i).Delete
        Next
    
        Dim shp As Shape
        Set shp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=30, Width:=70, Top:=20, Height:=120)
        
        With shp.TextFrame2.TextRange
            .Text = "Stack" & Chr(10) & "Over" & Chr(10) & "Flow" & Chr(10) & "is" & Chr(10) & "the" & Chr(10) & "best."
            .ParagraphFormat.Alignment = msoAlignCenter
            .Font.Fill.ForeColor.RGB = vbBlack
    
            ' Count lines by splitting using Chr(10) (line feed)
            Dim lines() As String
            lines = Split(.Text, Chr(10))
            Dim lineFeedCount As Integer
            lineFeedCount = UBound(lines) + 1
    
            Dim startPos As Integer, lineLength As Integer, currentLine As Integer
            startPos = 1
            
              For currentLine = 1 To lineFeedCount
                lineLength = Len(lines(currentLine - 1))
                
                If currentLine = 2 Then ' Second line should be red
                    .Characters(startPos, lineLength).Font.Fill.ForeColor.RGB = vbRed
                ElseIf currentLine = 5 Then ' Fifth line should be blue
                    .Characters(startPos, lineLength).Font.Fill.ForeColor.RGB = vbBlue
                End If
    
                startPos = startPos + lineLength + 1
            Next currentLine
        End With
    
    End Sub