Change specific text font color in shapes

zinah

Active Member
Joined
Nov 28, 2018
Messages
353
Office Version
  1. 365
Platform
  1. Windows
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?
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Try this:

Change data in red by your information

Code:
Sub Macro9()
    wText = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Shapes("[COLOR=#ff0000]Shapetst[/COLOR]").TextFrame.Characters.Text
    wString = "[COLOR=#ff0000]please change color to blue[/COLOR]"
    n = InStr(1, wText, wString)
    l = Len(wString)
    If n > 0 Then
        Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Shapes("[COLOR=#ff0000]Shapetst[/COLOR]").TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = [COLOR=#ff0000]5[/COLOR]
    End If
End Sub
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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?
 
Upvote 0
I show you an example


Code:
[COLOR=#0000ff]    wString = "more details can be found in our system"[/COLOR]
[COLOR=#0000ff]    l = Len(wString)[/COLOR]
    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
                        [COLOR=#0000ff]wText [/COLOR]= 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
[COLOR=#0000ff]                        n = InStr(1, wText, wString)[/COLOR]
[COLOR=#0000ff]                        If n > 0 Then[/COLOR]
[COLOR=#0000ff]                            shp.TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = 5[/COLOR]
[COLOR=#0000ff]                        End If[/COLOR]
                    End With
                End If
 
Upvote 0
I have updated my macro with blue text but there was no change, did I miss anything?
 
Upvote 0
Try this:

Change data in red by your information

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


Did you do a small test with the first code?
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top