Inserting Color Suit Symbols in Word

[Lorne50]

I am trying to update some system notes and trying to insert color suit symbols in my document. I can think of two ways to do this efficiently and wondered what other people have done.

 

 

By far the best IMO is to use auto text. Just put a symbol on the page, format it as symbol font and the right colour then go to insert auto text and add it to the list and assign a keyboard shortcut to it. For me Alt-C, alt-D, alt-H and alt-S insert correctly coloured and formatted symbols and allows me to type at normal speed when inserting them.

[meto]

I am trying to update some system notes and trying to insert color suit symbols in my document. I can think of two ways to do this efficiently and wondered what other people have done.

 

Method 1 - Record a Macro for inserting each suit symbol and assign a hotkey to each macro. Here's the code I wrote for this method:

 

Sub InsertClub()

Selection.Font.Color = wdColorGreen

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3929, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

Sub InsertDiamond()

Selection.Font.Color = wdColorOrange

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3928, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

Sub InsertHeart()

Selection.Font.Color = wdColorRed

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3927, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

Sub InsertSpade()

Selection.Font.Color = wdColorBlack

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3926, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

 

Method 2 - Use the AutoCorrect to insert the suit symbols and then write a macro to go through the entire document and replace all suit symbols with the same symbol but with the respective colors. The advantage of this method is you can use !c, !d, !h, and !s to edit the suit symbols in the document and then do one sweep at the end to attach the colors. The disadvantage is that it doesn't seem to work as I expect it to. Some of the symbols don't get converted and I don't understand why. Anyway, here is the code I have (mainly from recording and replacing code).

 

Sub SuitColors()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9827)

.Replacement.Text = ChrW(9827)

.Replacement.Font.Color = wdColorGreen

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9830)

.Replacement.Text = ChrW(9830)

.Replacement.Font.Color = wdColorOrange

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9829)

.Replacement.Text = ChrW(9829)

.Replacement.Font.Color = wdColorRed

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9824)

.Replacement.Text = ChrW(9824)

.Replacement.Font.Color = wdColorAutomatic

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub

 

Any thoughts from other people? What has been successful for you? Any other methods that may work better?

[meto]

I managed to have method-1 work perfectly well, however, I couldn't have the method-2 work... Are there any further tips to have it work? I have actually copied the code and pasted in the modules then just run the code but no suit color has changed in my document.

What I really need to do is to have the TOC back to its original form after it has turned all suit colors to black; by default when I happen to update it.

 

Any suggestions are welcome !

[gordontd]

Here's what I use after writing text with Sx, Hx, Dx, Cx instead of the symbols for Spades, Hearts, Diamonds, Clubs.

 

Sub SuitXcolours()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "Cx"

.Replacement.Text = ChrW(9827)

.Replacement.Font.Color = wdColorGreen

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "Dx"

.Replacement.Text = ChrW(9830)

.Replacement.Font.Color = wdColorOrange

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "Hx"

.Replacement.Text = ChrW(9829)

.Replacement.Font.Color = wdColorRed

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "Sx"

.Replacement.Text = ChrW(9824)

.Replacement.Font.Color = wdColorBlue

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub

[meto]

your putting x next to C, D, H, S seems to solve only one problem... e.i. converting Texts to the suits with the colors we want... However, it does not help changing those symbols back to the original after TOC have changed all colors to black..

 

So what we actually need is be able to change the color of symbols from whatever color they have been changed into back to their original colors as we want them..

 

Any code for clearing the wrong format and getting them back to the original state with the right colors?

[gordontd]

your putting x next to C, D, H, S seems to solve only one problem... e.i. converting Texts to the suits with the colors we want... However, it does not help changing those symbols back to the original after TOC have changed all colors to black..

 

So what we actually need is be able to change the color of symbols from whatever color they have been changed into back to their original colors as we want them..

 

Any code for clearing the wrong format and getting them back to the original state with the right colors?

I haven't tried this, but logically I would have thought editing the above procedure for all four as below would do it:

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9824)

.Replacement.Font.Color = wdColorBlue

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub

[gordontd]

I have now tried it and it worked fine, so the full procedure would be:

Sub SuitColours()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9827)

.Replacement.Font.Color = wdColorGreen

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9830)

.Replacement.Font.Color = wdColorOrange

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9829)

.Replacement.Font.Color = wdColorRed

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9824)

.Replacement.Font.Color = wdColorBlue

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub

 

Change the colours if you prefer.

[Tramticket]

Simple solution:

 

(1) insert the suit symbols as black - I set up [alt]s, [alt]h, [alt]d and [alt]c for this.

(2) once you have finished the document, use the replace function to add the colour formating. Select the Replace from the toolbar; type ♥ into both the "Find what" and "Replace with" boxes; click on More>>; then click on Format, Font and select the colour red; click on replace all. Repeat for the diamond suit. [Personally I prefer to leave clubs and spades black!].

 

No macros needed.

[r_pakker]

I am trying to update some system notes and trying to insert color suit symbols in my document. I can think of two ways to do this efficiently and wondered what other people have done.

 

Method 1 - Record a Macro for inserting each suit symbol and assign a hotkey to each macro. Here's the code I wrote for this method:

 

Sub InsertClub()

Selection.Font.Color = wdColorGreen

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3929, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

Sub InsertDiamond()

Selection.Font.Color = wdColorOrange

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3928, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

Sub InsertHeart()

Selection.Font.Color = wdColorRed

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3927, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

Sub InsertSpade()

Selection.Font.Color = wdColorBlack

Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3926, Unicode:=True

Selection.Font.Color = wdColorAutomatic

End Sub

 

Method 2 - Use the AutoCorrect to insert the suit symbols and then write a macro to go through the entire document and replace all suit symbols with the same symbol but with the respective colors. The advantage of this method is you can use !c, !d, !h, and !s to edit the suit symbols in the document and then do one sweep at the end to attach the colors. The disadvantage is that it doesn't seem to work as I expect it to. Some of the symbols don't get converted and I don't understand why. Anyway, here is the code I have (mainly from recording and replacing code).

 

Sub SuitColors()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9827)

.Replacement.Text = ChrW(9827)

.Replacement.Font.Color = wdColorGreen

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9830)

.Replacement.Text = ChrW(9830)

.Replacement.Font.Color = wdColorOrange

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9829)

.Replacement.Text = ChrW(9829)

.Replacement.Font.Color = wdColorRed

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = ChrW(9824)

.Replacement.Text = ChrW(9824)

.Replacement.Font.Color = wdColorAutomatic

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub

 

Any thoughts from other people? What has been successful for you? Any other methods that may work better?

Hello 'Echonome'

 

Since long I avoid making use of the 'symbol font'. Not everybody has this font on his/her device.

For no trump I use the 'white sun' symbol. And I added 'double' and 'redouble' macro's.

'.InsertAfter ""' is added because it stops continuing sometimes typing in the wrong color when you have deleted text after a coloured symbol.

I coupled these macro's to free <ALT-Key>'s.

 

 

Sub klaver()

'

' klaver/club

'

'

With Selection

.Font.Color = wdColorBlack

.TypeText (ChrW(9827))

.Font.Color = wdColorAutomatic

.InsertAfter ""

End With

End Sub

 

Sub ruiten()

'

' ruiten/diamond

'

With Selection

.Font.Color = wdColorRed

.TypeText (ChrW(9830))

.Font.Color = wdColorAutomatic

.InsertAfter ""

End With

End Sub

 

Sub harten()

'

' harten/heart

'

With Selection

.Font.Color = wdColorRed

.TypeText (ChrW(9829))

.Font.Color = wdColorAutomatic

.InsertAfter ""

End With

End Sub

 

Sub schoppen()

'

' schoppen/spade

'

With Selection

.Font.Color = wdColorBlack

.TypeText (ChrW(9824))

.Font.Color = wdColorAutomatic

.InsertAfter ""

End With

End Sub

 

Sub sans()

'

' sans/notrump

'

With Selection

.Font.Color = wdColorBrightGreen

.TypeText (ChrW(9788))

.Font.Color = wdColorAutomatic

.InsertAfter ""

End With

 

 

End Sub

 

Sub doublet()

'

' doublet/double

'

With Selection

.Font.Shading.BackgroundPatternColor = wdColorRed

.Font.Color = wdColorWhite

.TypeText ("X")

.Font.Shading.BackgroundPatternColor = wdColorAutomatic

.Font.Color = wdColorAutomatic

.InsertAfter ""

End With

 

End Sub

Sub redoublet()

'

' redoublet/redouble

'

'

With Selection

.Font.Shading.BackgroundPatternColor = wdColorBlue

.Font.Color = wdColorWhite

.TypeText ("XX")

.Font.Shading.BackgroundPatternColor = wdColorAutomatic

.Font.Color = wdColorAutomatic

.InsertAfter ""

End With

 

End Sub

[barmar]

Hello 'Echonome'

Echognome hasn't logged into the forum in 5 years, I don't think he'll see your reply.