MS Word Macros for WDC

About This Author

MS Word Macros for WDC

Sub StartHighlight()
'
' StartHighlight Macro
'
'
Selection.TypeText Text:="{b}{c:blue}{e:cut}"
Selection.MoveLeft Unit:=wdCharacter, Count:=18, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdGray25
Selection.Range.HighlightColorIndex = wdGray25
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

Sub StopHighlight()
'
' StopHighlight Macro
'
'
Selection.TypeText Text:="{e:cut}{/c}{/b}"
Selection.MoveLeft Unit:=wdCharacter, Count:=15, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdGray25
Selection.Range.HighlightColorIndex = wdGray25
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

Sub Comment()
'
' Comment Macro
'
'
Selection.TypeText Text:="{b}{c:red}{e:exclaim}My Comment: {e:exclaim}{/c}{/b}"
Selection.MoveLeft Unit:=wdCharacter, Count:=21
Selection.MoveLeft Unit:=wdCharacter, Count:=15, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdYellow
Selection.Range.HighlightColorIndex = wdYellow
Selection.MoveRight Unit:=wdCharacter, Count:=1

End Sub

Sub StartTypo()
'
' StartTypo Macro
'
'
Selection.TypeText Text:="{b}{c:blue}{u}"
Selection.MoveLeft Unit:=wdCharacter, Count:=14, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdPink
Selection.Range.HighlightColorIndex = wdPink
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

Sub StopTypo()
'
' StopTypo Macro
'
'
Selection.TypeText Text:="{/u}{/c}{c:red}Typo...{/c}{/b}"
Selection.MoveLeft Unit:=wdCharacter, Count:=15, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdPink
Selection.Range.HighlightColorIndex = wdPink
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
'
Sub StartUnderline()
Selection.TypeText Text:="{b}{c:blue}{u}"
Selection.MoveLeft Unit:=wdCharacter, Count:=14, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdPink
Selection.Range.HighlightColorIndex = wdPink
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
'
Sub EndUnderline()
Selection.TypeText Text:="{/u}{/c}{/b}"
Selection.MoveLeft Unit:=wdCharacter, Count:=11, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdPink
Selection.Range.HighlightColorIndex = wdPink
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
'
Sub FormatToWrtingML()
'
' FormatToWrtingML Macro
'
'
Application.ScreenUpdating = False
ConvertItalic
ConvertCenter
' Copy to clipboard
ActiveDocument.Content.Copy
Application.ScreenUpdating = True
End Sub

Private Sub ConvertItalic()
ActiveDocument.Select

With Selection.Find

.ClearFormatting
.Font.Italic = True
.Text = ""

.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

.Forward = True
.Wrap = wdFindContinue

Do While .Execute
With Selection
If InStr(1, .Text, vbCr) Then
' Just process the chunk before any newline characters
' We'll pick-up the rest with the next search
.Font.Italic = False
.Collapse
.MoveEndUntil vbCr
End If

' Don't bother to markup newline characters (prevents a loop, as well)
If Not .Text = vbCr Then
.InsertBefore "{i}"
.InsertAfter "{/i}"
End If

.Font.Italic = False
End With
Loop
End With
End Sub

Private Sub ConvertCenter()
ActiveDocument.Select

With Selection.Find

.ClearFormatting
.ParagraphFormat.Alignment = wdAlignParagraphCenter
'.Font.Italic = True
.Text = ""

.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

.Forward = True
.Wrap = wdFindContinue

Do While .Execute
With Selection
If InStr(1, .Text, vbCr) Then
' Just process the chunk before any newline characters
' We'll pick-up the rest with the next search
.ParagraphFormat.Alignment = wdAlignParagraphLeft
'.Font.Italic = False
.Collapse
.MoveEndUntil vbCr
End If

' Don't bother to markup newline characters (prevents a loop, as well)
If Not .Text = vbCr Then
.InsertBefore "{center}"
.InsertAfter "{/center}"
End If
.ParagraphFormat.Alignment = wdAlignParagraphLeft
'.Font.Italic = False
End With
Loop
End With
End Sub

InkSpot.Com, its affiliates and syndicates have been granted non-exclusive rights to display this work.