Echognome, on 2010-February-28, 14:35, said:
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