How to choose the color and do random color word??

I would like to fill in the documents of the pink color of the text change color, eight-color, random variable

thank you

Sub TEST()
Dim s As Shape
Dim n As Long, num As Long
Dim trChar As TextRange
Dim p As Page

Set s = ActiveShape
num = ActivePalette.ColorCount 'Get the number of colors in our palette

'Optimization = True
For Each p In ActiveDocument.Pages
For Each trChar In s.Text.Story.Characters(Query:="@Fill.color = 'pink'")
n = CLng(Fix(Rnd() * num)) + 1 'Get a random color from the palette
trChar.Fill.ApplyUniformFill ActivePalette.Color(n)
Next trChar
Next p
'Optimization = False
'ActiveWindow.Refresh
End Sub

[shelbym]

Not much different than the random outline color. Hope it helps.

Sub RandomCharacterColor()
    Dim s As Shape
    Dim n As Long, num As Long
    Dim trChar As TextRange
    
    Set s = ActiveShape
    If s Is Nothing Then MsgBox "Please select some text.": Exit Sub
    If s.Type <> cdrTextShape Then MsgBox "Please select some text.": Exit Sub
    
    num = ActivePalette.ColorCount 'Get the number of colors in our palette
    
    Optimization = True
        
        For Each trChar In s.Text.Story.Characters
            n = CLng(Fix(Rnd() * num)) + 1 'Get a random color from the palette
            trChar.Fill.ApplyUniformFill ActivePalette.Color(n)
        Next trChar
    
    Optimization = False
    ActiveWindow.Refresh
End Sub

Good Luck,

-Shelby

I want to document the color of pink fill the text change, the designated eight-color, random discoloration.

Sub test()
Dim s As Shape
Dim n As Long, num As Long
Dim trChar As TextRange
Dim p As Page

Set s = ActiveShape
num = ActivePalette.ColorCount 'Get the number of colors in our palette

'Optimization = True
For Each p In ActiveDocument.Pages
For Each trChar In s.Text.Story.Characters(Query:="@Fill.color = 'pink'")
n = CLng(Fix(Rnd() * num)) + 1 'Get a random color from the palette
trChar.Fill.ApplyUniformFill ActivePalette.Color(n)
Next trChar
Next p
'Optimization = False
'ActiveWindow.Refresh
End Sub

THK.

I would like to fill in the documents of the pink color of the text change color, eight-color, random variable

Sub TEST()
Dim s As Shape
Dim n As Long, num As Long
Dim trChar As TextRange
Dim p As Page

Set s = ActiveShape
num = ActivePalette.ColorCount 'Get the number of colors in our palette

'Optimization = True
For Each p In ActiveDocument.Pages
For Each trChar In s.Text.Story.Characters(Query:="@Fill.color = 'pink'")
n = CLng(Fix(Rnd() * num)) + 1 'Get a random color from the palette
trChar.Fill.ApplyUniformFill ActivePalette.Color(n)
Next trChar
Next p
'Optimization = False
'ActiveWindow.Refresh
End Sub

Please help me to modify, thank you!

help me

[shelbym]

First you want to take out the code the loops each page. This is because we are working with the currently selected object only. By looping pages you are just repeating the fill on the selected shapes times the number of pages. Takes more time, and doesn't really do anything.

Second, you can't use CQL to find characters, it will only find shapes. So that goes also. If you just want to change the fill of pink characters the code would look like this:

Sub TEST()
    Dim s As Shape
    Dim n As Long, num As Long
    Dim trChar As TextRange
    
    Set s = ActiveShape
    num = ActivePalette.ColorCount 'Get the number of colors in our palette
    
    Optimization = True
    
        For Each trChar In s.Text.Story.Characters
            If trChar.Fill.UniformColor.Name = "Pink" Then
                n = CLng(Fix(Rnd() * num)) + 1 'Get a random color from the palette
                trChar.Fill.ApplyUniformFill ActivePalette.Color(n)
            End If
        Next trChar
    
    Optimization = False
    ActiveWindow.Refresh
End Sub

Best of luck!

-Shelby