Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 15

Thread: Change specific text font color in shapes

  1. #1
    Board Regular
    Join Date
    Nov 2018
    Location
    US, TX
    Posts
    113
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Change specific text font color in shapes

    Hi,

    I have shapes that have text and I need to change the text font color of any "please change color to blue - example" if it's found in shapes. How can I do that in a macro?

  2. #2
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    3,134
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    9 Thread(s)

    Default Re: Change specific text font color in shapes

    Try this:

    Change data in red by your information

    Code:
    Sub Macro9()
        wText = Sheets("Sheet1").Shapes("Shapetst").TextFrame.Characters.Text
        wString = "please change color to blue"
        n = InStr(1, wText, wString)
        l = Len(wString)
        If n > 0 Then
            Sheets("Sheet1").Shapes("Shapetst").TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = 5
        End If
    End Sub
    Regards Dante Amor

  3. #3
    Board Regular
    Join Date
    Nov 2018
    Location
    US, TX
    Posts
    113
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Change specific text font color in shapes

    How can I write it within below macro?

    Code:
       Set aSht = ActiveSheet    Set rSht = Sheets("Role Scorecard")
        rSht.Activate
    
    
    
    
    Dim oCnt As Long, o As Long '>>>set the limit of objectives count
    Dim shp As Shape
    Dim ObjRng As Range, MetRng As Range, catRng As Range
    Dim objLbl As Shape, outLbl As Shape, catLbl As Shape
    Dim prgTxt As String, prglbl As String
    
    
    oCnt = 20
    If oCnt > 5 Then oCnt = 5
    
    
        Set ObjRng = Sheets("ref.").[Pop_ObjRng]
        Set MetRng = Sheets("ref.").[Pop_OutRng]
        Set numRng = Sheets("ref.").[NumRange]
        Set catRng = Sheets("ref.").[CatRange]
        Set PrgRng = Sheets("ref.").[ProgRange]
        Set ModRng = Sheets("ref.").[Mod_Date]
    
    
        
    For o = 1 To oCnt
    
    
    For lbl = ObjRng.Row To (ObjRng.Row + ObjRng.Rows.Count - 1)
        i = i + 1
        
        For Each shp In ActiveSheet.Shapes
        If InStr(1, shp.Name, "Goal_" & i & "_Obj") > 0 Then
            With shp
                .TextFrame2.TextRange.Characters.Text = Sheets("ref.").Cells(lbl, numRng.Column) & " " & "Objective: " & "Last modified" & " " & Sheets("ref.").Cells(lbl, ModRng.Column).Value & Chr(10) & Sheets("ref.").Cells(lbl, ObjRng.Column).Value
                .TextFrame2.TextRange.Font.Bold = msoFalse
                '.TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, ObjRng), Len(ObjRng)).Font.Bold = True
                .TextFrame2.TextRange.Characters(1, 14).Font.Bold = msoCTrue
        
            End With
        End If
        
        If InStr(1, shp.Name, "Goal_" & i & "_Out") > 0 Then
            With shp
            .TextFrame2.TextRange.Characters.Text = "Metrics/Outcomes: " & Chr(10) & Sheets("ref.").Cells(lbl, MetRng.Column).Value
            .TextFrame2.TextRange.Font.Bold = msoFalse
            .TextFrame2.TextRange.Characters(1, 17).Font.Bold = msoCTrue
            End With
        End If
        
        If InStr(1, shp.Name, "Goal_" & i & "_Cat") > 0 Then
            With shp
            .TextFrame2.TextRange.Characters.Text = Sheets("ref.").Cells(lbl, catRng.Column).Value
            .TextFrame2.TextRange.Font.Bold = msoFalse
            End With
        End If
        
        If InStr(1, shp.Name, "Goal_" & i & "_Prg") > 0 Then
            With shp
            .TextFrame2.TextRange.Characters.Text = "Progress Notes: " & Chr(10) & Sheets("ref.").Cells(lbl, PrgRng.Column).Value
            .TextFrame2.TextRange.Font.Bold = msoFalse
            .TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, prgTxt), Len(prgTxt)).Font.Bold = False
            prglbl = "Progress Notes: "
            prgTxt = Sheets("ref.").[G_Prog].Offset(1, 0).Value
            .TextFrame2.TextRange.Characters.Text = prglbl & prgTxt
            .TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, prgTxt), Len(prgTxt)).Font.Bold = True
            .TextFrame.Characters(InStr(1, (prglbl & prgTxt), prgTxt), Len(prgTxt)).Font.Color = RGB(0, 0, 255)
            If prgTxt = "NO" Then _
            .TextFrame.Characters(InStr(1, (prglbl & prgTxt), prgTxt), Len(prgTxt)).Font.Color = RGB(255, 0, 0)
            
            
            End With
            
            
        End If
        
        Next shp
    Next lbl
    Next o

  4. #4
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    3,134
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    9 Thread(s)

    Default Re: Change specific text font color in shapes

    What is the text you want to search?
    You could explain with a real example, what do you have of text in the shape, what are you going to look for and what do you want to change color?
    Regards Dante Amor

  5. #5
    Board Regular
    Join Date
    Nov 2018
    Location
    US, TX
    Posts
    113
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Change specific text font color in shapes

    These boxes that macro generates have different text that depends on each employee goal, the text may or may not have this text “ more details can be found in our system” this specific text maybe included in any shape name that includes “goal_& i&_obj” and “goal_& I &_out”
    does that make sense?

  6. #6
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    3,134
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    9 Thread(s)

    Default Re: Change specific text font color in shapes

    I show you an example


    Code:
        wString = "more details can be found in our system"
        l = Len(wString)
        For o = 1 To oCnt
            For lbl = ObjRng.Row To (ObjRng.Row + ObjRng.Rows.Count - 1)
                i = i + 1
                For Each shp In ActiveSheet.Shapes
                    If InStr(1, shp.Name, "Goal_" & i & "_Obj") > 0 Then
                        With shp
                            wText = Sheets("ref.").Cells(lbl, numrng.Column) & " " & _
                                "Objective: " & "Last modified" & " " & _
                                Sheets("ref.").Cells(lbl, ModRng.Column).Value & Chr(10) & _
                                Sheets("ref.").Cells(lbl, ObjRng.Column).Value
                            .TextFrame2.TextRange.Characters.Text = wText
                            .TextFrame2.TextRange.Font.Bold = msoFalse
                            '.TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, ObjRng), Len(ObjRng)).Font.Bold = True
                            .TextFrame2.TextRange.Characters(1, 14).Font.Bold = msoCTrue
                            n = InStr(1, wText, wString)
                            If n > 0 Then
                                shp.TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = 5
                            End If
                        End With
                    End If
    Regards Dante Amor

  7. #7
    Board Regular
    Join Date
    Nov 2018
    Location
    US, TX
    Posts
    113
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Change specific text font color in shapes

    I have updated my macro with blue text but there was no change, did I miss anything?

  8. #8
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    3,134
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    9 Thread(s)

    Default Re: Change specific text font color in shapes

    Quote Originally Posted by DanteAmor View Post
    Try this:

    Change data in red by your information

    Code:
    Sub Macro9()
        wText = Sheets("Sheet1").Shapes("Shapetst").TextFrame.Characters.Text
        wString = "please change color to blue"
        n = InStr(1, wText, wString)
        l = Len(wString)
        If n > 0 Then
            Sheets("Sheet1").Shapes("Shapetst").TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = 5
        End If
    End Sub

    Did you do a small test with the first code?
    Regards Dante Amor

  9. #9
    Board Regular
    Join Date
    Nov 2018
    Location
    US, TX
    Posts
    113
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Change specific text font color in shapes

    Yes, I did and the text changed to blue but with original file it didn't work

    here's a test file

    https://www.dropbox.com/s/fgfnqup0o4...ook1.xlsm?dl=0
    Last edited by zinah; Apr 20th, 2019 at 09:31 PM.

  10. #10
    Board Regular
    Join Date
    Nov 2018
    Location
    US, TX
    Posts
    113
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Change specific text font color in shapes


Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •