Attribute VB_Name = "Itracks_4_module"
Option Explicit



Sub Format_Html()
'
' Convert bold, italic, and underline to html tags Macro
' Macro originally designed by Lucas Brachish Celebrity Cola.blogspot.com
' Adapted by P. Belisle 2008
' With code from Word MVP Bill Coan (http://word.mvps.org/)
'
' Replace bold
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
.Text = "<*>"
.Replacement.Text = "<b>^&</b>"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Replace italic
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
Selection.Find.ClearFormatting
Selection.Find.Font.Italic = True
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = False
With Selection.Find
.Text = "<*>"
.Replacement.Text = "<i>^&</i>"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Replace underline
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
Selection.Find.ClearFormatting
Selection.Find.Font.Underline = wdUnderlineSingle
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Underline = wdUnderlineNone
With Selection.Find
.Text = "<*>"
.Replacement.Text = "<u>^&</u>"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<<u>b</u>><u>"
.Replacement.Text = "<u><b>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Get rid of all of the extraneous symbols caused by the replacing
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "<<i>b</i>><i>"
.Replacement.Text = "<i><b>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "<<u>i</u>><u>"
.Replacement.Text = "<u><i>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "</u></<u>b</u>>"
.Replacement.Text = "</b></u>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "</i></<i>b</i>>"
.Replacement.Text = "</b></i>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "</u></<u>i</u>>"
.Replacement.Text = "</i></u>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "<<u><i>b</i></u>><u><i>"
.Replacement.Text = "<u><i><b>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "</i></u></<u><i>b</i></u>>"
.Replacement.Text = "</b></i></u>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "<b<"
.Replacement.Text = "<b><"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "<<"
.Replacement.Text = "<"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = ">>"
.Replacement.Text = ">"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "^p"
.Replacement.Text = "</p><p>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.SelectColumn
If Selection.Information(wdWithInTable) Then
    Selection.Columns(1).Select
    Selection.SetRange _
            Start:=Selection.Cells(2).Range.Start, _
            End:=Selection.End
End If
With Selection.Find
.Text = "</p><p></p><p>"
.Replacement.Text = "</p><p>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub