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