OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 16-08-2008, 20:38
sy168
Guest
 
Posts: n/a
Question 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
Attached Images
 
Attached Files
File Type: cdr Graphic1.cdr (25.2 KB, 20 views)

Last edited by sy168; 18-08-2008 at 00:27.
Reply With Quote
  #2  
Old 17-08-2008, 16:56
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,778
Blog Entries: 11
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Try this....

Not much different than the random outline color. Hope it helps.
Code:
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
Reply With Quote
  #3  
Old 18-08-2008, 00:01
sy168
Guest
 
Posts: n/a
Default

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.
Reply With Quote
  #4  
Old 18-08-2008, 00:11
sy168
Guest
 
Posts: n/a
Default

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!
Reply With Quote
  #5  
Old 18-08-2008, 00:29
sy168
Guest
 
Posts: n/a
Default

help me
Reply With Quote
  #6  
Old 18-08-2008, 12:21
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,778
Blog Entries: 11
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Couple of things....

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:
Code:
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
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
How to select the black lines, fill in random colors? sy168 CorelDRAW/Corel DESIGNER VBA 2 16-08-2008 03:23
Random Outlines TTerrell General 2 18-06-2007 08:06
Help with Color please KeithXP Corel Photo-Paint VBA 2 18-12-2006 12:40
1 color by layer 835 General 2 09-08-2005 03:41
Color Replecer - not replece white color Zuk Macros/Add-ons 2 30-04-2003 01:44


All times are GMT -5. The time now is 01:10.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com