On the face of it there's little more pointless than a set of macros to turn MS Word documents into html when the functionality is built into MS Word anyway. However I still find these useful. They are *extremely* limited in what they do and produce the simplest of html, discarding almost all formatting and other enhancements. And that is precisely the point. I like to have a lot of control of my html, so all that these macros do is to put Word Heading1 to Heading6 styles in h1 to h6 tags, convert Word tables to unformatted html tables, bring Word footnotes and endnotes into the main document and handle a couple of entity conversions I find useful. Everything else is discarded. It also doesn't produce an html document, just converts your current page so you can paste it into your chosen html editor and add details of style sheets and so on.
I must apologise for the code. This is particularly rough and ready stuff, poorly commented and very crude - mostly just simple recordings of manually converting part of the text and then tidying it up later and adding loops and so on. Its not very elegant. You could do better. Even *I* could do better, but I don't seem to need to. It's roughly in Word 2013 status, but most of it was written in Word 97 VBA. You'll also see that sometimes I have just repeated blocks of almost identical code in line when it might be more elegant to have used more functions and make the code a little more objectified. Laziness I'm afraid.
To use the macro suite paste the whole code section into an appropriate word template, either your main personal macro template, or else a custom one you will use for word conversions. From there you could edit the ribbon to add buttons for one or more macros, or you could simply run the macro manually. HTMLConversion is the main macro that runs all the others to convert your current on screen document, and if I were you I'd have a button on the toolbar for that. I find I often use crstrip for all sorts of odd jobs so I suggest you have a button for that as well. Apart from that you might find the table conversion of use on its own, but I don't think I've ever wanted to call any of the others separately.
You are probably best off taking this and using it in part and extending it in part. Portions of this code have had various roles over the years, including at one stage what amounted to a primitive CMS which handled many more html tags than are included here. However what you have here is what meets my needs now. If, as is likely, you want to do a few more wrd formatting options then I suggest you take a look at the way superscript is handled and do something similar for other styles that you need to do. These days though I am much more likely to use CSS styles than the simple basic html tags that this was designed to produce, and I'd recommend you do the same.
I must also give credit to someone whose name I have forgotten. Back in the mid 1990s I downloaded a set of wordbasic macros which converted Word files to html. I am quite confident that every last vestige of that code is long gone, and I deliberately rewrote them all from scratch into VBA for Word 97, but that download gave me the original inspiration. Whoever you were: thank you, and apologies for forgetting your name. I can't pay you back, so this is the pay forward.
I've presented this as a code secton rather than a download. I think its all translated properly for that presentation, but if you try it and find any problems please let me know.
Option Explicit
'University of Illinois/NCSA Open Source License
'Copyright (c) 1995-2014 Jim Champ
'All rights reserved.
'Jim's WordHTM
'Developed by: Jim Champ
'Permission is hereby granted, free of charge, to any person obtaining a
'copy of this software and associated documentation files (the "Software"),
'to deal with the Software without restriction, including without
'limitation the rights to use, copy, modify, merge, publish, distribute,
'sublicense, and/or sell copies of the Software, and to permit persons to
'whom the Software is furnished to do so, subject to the following
'conditions:
' * Redistributions of source code must retain the above copyright
' notice, this list of conditions and the following disclaimers.
' * Redistributions in binary form must reproduce the above copyright
' notice, this list of conditions and the following disclaimers in the
' documentation and/or other materials provided with the distribution.
' * Neither the names of Jim Champ,
' nor the names of its contributors may be used to endorse or promote
' products derived from this Software without specific prior written
' permission.
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
' OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
' IN NO EVENT SHALL THE CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR
' ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
' CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH
' THE SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE SOFTWARE.
Sub CRStrip()
'
' crstrip Macro
' Macro recorded 17/10/05 by Jim Champ
' This macro takes single carriage returns out of a document but retains
' double carriage returns. Quite useful for reading taxt documents as well as the html suite
'
Dim StripRange As Range
Set StripRange = ActiveDocument.Range(Start:=0, End:=ActiveDocument.Range.End)
StripRange.Find.ClearFormatting
StripRange.Find.Replacement.ClearFormatting
With StripRange.Find
.Text = "^l"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
StripRange.Find.Execute Replace:=wdReplaceAll
With StripRange.Find
.Text = "^p^p"
.Replacement.Text = "~~~~"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
StripRange.Find.Execute Replace:=wdReplaceAll
With StripRange.Find
.Text = "^p"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
StripRange.Find.Execute Replace:=wdReplaceAll
With StripRange.Find
.Text = "~~~~"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
StripRange.Find.Execute Replace:=wdReplaceAll
ActiveWindow.ActivePane.LargeScroll Down:=-1
ActiveWindow.ActivePane.LargeScroll Down:=1
End Sub
Sub HTMLConversion()
HTMLEntities
HTMLFootnoteConversion
HTMLEndNoteConversion
HTMLTables
HTMLSuperscript
HTMLStylesfromWord
HtmlTidyUp
End Sub
Sub HTMLTables()
Dim ActionComplete As Integer
Dim rngWorkingTableArea As Range
'start at the beginning
Selection.HomeKey Unit:=wdStory
'find a table
Selection.GoTo what:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
ActionComplete = 0
While ActionComplete = 0
On Error GoTo NoMoreTables
'Select our current table and define it as a named range
Selection.Tables(1).Select
Set rngWorkingTableArea = Selection.Range
rngWorkingTableArea.Tables(1).Select
rngWorkingTableArea.Style = ActiveDocument.Styles("Plain Text")
rngWorkingTableArea.Rows.ConvertToText Separator:=wdSeparateByTabs
rngWorkingTableArea.Find.ClearFormatting
rngWorkingTableArea.Find.Replacement.ClearFormatting
With rngWorkingTableArea.Find
.Text = "^t"
.Replacement.Text = "</td>^t<td>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
rngWorkingTableArea.Find.Execute Replace:=wdReplaceAll
With rngWorkingTableArea.Find
.Text = "^p"
.Replacement.Text = "</td><tr>^p<tr><td>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
rngWorkingTableArea.Find.Execute Replace:=wdReplaceAll
'NB: This has put a spurious extra <tr><td> at the end of the
'table, and we are lacking one at the beginning
'Now start the table and put the first line start in
Selection.GoTo what:=wdGoToObject, Name:=rngWorkingTableArea.Start
Selection.TypeText Text:="<table>"
Selection.TypeParagraph
Selection.TypeText Text:="<tr><td>"
'now move selection to the end of the range
Selection.Start = rngWorkingTableArea.End
'select the last line which is our spurious <tr><td> and delete it
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Cut
'and finish off the table
Selection.TypeText Text:="</table>"
'and go for the next one
Selection.GoTo what:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
Wend
NoMoreTables:
'Exit point for the loop
End Sub
Sub HTMLStylesfromWord()
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Normal")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<p>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</p>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<h1>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</h1>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 2")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<h2>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</h2>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 3")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<h3>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</h3>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 4")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<h4>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</h4>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 5")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<h5>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</h5>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 6")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<h6>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</h6>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
End Sub
Sub HTMLEndNoteConversion()
Dim i As Integer
If ActiveDocument.Endnotes.Count < 1 Then
Exit Sub
End If
If ActiveWindow.ActivePane.View.Type = wdPageView Or _
ActiveWindow.ActivePane.View.Type = wdOnlineView Or _
ActiveWindow.ActivePane.View.Type = wdPrintPreview Then
ActiveWindow.View.SeekView = wdSeekEndnotes
Else
ActiveWindow.View.SplitSpecial = wdPaneEndnotes
End If
For i = ActiveDocument.Endnotes.Count To 1 Step -1
Selection.GoTo what:=wdGoToEndnote, Which:=wdGoToAbsolute, Count:=i
Selection.TypeText Text:="(" & Trim(Str(i)) & ")"
Selection.Delete Unit:=wdCharacter, Count:=1
Next
Selection.WholeStory
Selection.Copy
If ActiveWindow.ActivePane.View.Type = wdPageView Or _
ActiveWindow.ActivePane.View.Type = wdOnlineView Or _
ActiveWindow.ActivePane.View.Type = wdPrintPreview Then
ActiveWindow.View.SeekView = wdSeekMainDocument
Else
ActiveWindow.Panes(2).Close
End If
Selection.EndKey Unit:=wdStory
Selection.TypeText Text:="EndNotes"
Selection.Style = ActiveDocument.Styles("Heading 2")
Selection.TypeParagraph
Selection.Paste
For i = ActiveDocument.Endnotes.Count To 1 Step -1
Selection.GoTo what:=wdGoToEndnote, Which:=wdGoToFirst, Count:=i
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^f"
.Replacement.Text = "(" & Trim(Str(i)) & ")"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceOne
.Style = ActiveDocument.Styles("Plain Text")
End With
Next
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("EndNote Text")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<p>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</p>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
End Sub
Sub HTMLFootnoteConversion()
Dim i As Integer
If ActiveDocument.Footnotes.Count < 1 Then
Exit Sub
End If
If ActiveWindow.ActivePane.View.Type = wdPageView Or _
ActiveWindow.ActivePane.View.Type = wdOnlineView Or _
ActiveWindow.ActivePane.View.Type = wdPrintPreview Then
ActiveWindow.View.SeekView = wdSeekFootnotes
Else
ActiveWindow.View.SplitSpecial = wdPaneFootnotes
End If
For i = ActiveDocument.Footnotes.Count To 1 Step -1
Selection.GoTo what:=wdGoToFootnote, Which:=wdGoToAbsolute, Count:=i
Selection.TypeText Text:="(" & Trim(Str(i)) & ")"
Selection.Delete Unit:=wdCharacter, Count:=1
Next
Selection.WholeStory
Selection.Copy
If ActiveWindow.ActivePane.View.Type = wdPageView Or _
ActiveWindow.ActivePane.View.Type = wdOnlineView Or _
ActiveWindow.ActivePane.View.Type = wdPrintPreview Then
ActiveWindow.View.SeekView = wdSeekMainDocument
Else
ActiveWindow.Panes(2).Close
End If
Selection.EndKey Unit:=wdStory
Selection.TypeText Text:="Footnotes"
Selection.Style = ActiveDocument.Styles("Heading 2")
Selection.TypeParagraph
Selection.Paste
For i = ActiveDocument.Footnotes.Count To 1 Step -1
Selection.GoTo what:=wdGoToFootnote, Which:=wdGoToFirst, Count:=i
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^f"
.Replacement.Text = "(" & Trim(Str(i)) & ")"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceOne
.Style = ActiveDocument.Styles("Plain Text")
End With
Next
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Footnote Text")
With Selection.Find
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.Style = ActiveDocument.Styles("Plain Text")
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="<p>"
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</p>"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Exit Do
End If
End With
Loop
End Sub
Sub HtmlTidyUp()
'
' TidyHtml Macro
' Macro recorded 08/03/10 by Jim Champ
'
Selection.WholeStory
With Selection.Font
.Name = "Courier New"
.Size = 10
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.ColorIndex = wdAuto
.Engrave = False
.Superscript = False
.Subscript = False
End With
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "?"
.Replacement.Text = "..."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "?"
.Replacement.Text = "-"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
CRStrip
With Selection.Find
.Text = "/p>"
.Replacement.Text = "/p>^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "</tr>"
.Replacement.Text = "</tr>^p"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "<tr>"
.Replacement.Text = "^p<tr>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "<td>"
.Replacement.Text = "^p^t<td>"
.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
Sub HTMLEntities()
'
' htmlEntities Macro
' Macro recorded 05/11/11 by Jim Champ
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " & "
.Replacement.Text = " & "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = """"
.Replacement.Text = """
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "¸"
.Replacement.Text = "©"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "'"
.Replacement.Text = "'"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub HTMLSuperscript()
'
' HTMLSuperscript Macro
' Macro recorded 05/11/11 by Jim Champ
Do
Selection.Find.ClearFormatting
With Selection.Find.Font
.Superscript = True
End With
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found = True Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="<sup>"
Selection.Find.ClearFormatting
With Selection.Find.Font
.Superscript = False
End With
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</sup>"
Else
Exit Do
End If
End With
Loop
End Sub
These snippets and utilities are licensed under the University of Illinois/NCSA Open Source License. Here is the text of the license as it applies to this code.