Microsoft Word Macros

Microsoft Word Macros are scripts that can be added to Microsoft Word which allows you to convert word documents to mediawiki coding for easy copying and pasting into your wiki.

Wikipedia AutoReferencer
This Autoreferencer will turn hyperlinks in a Microsoft Word document into Wikipedia-friendly references.
 * 1) Click ‘View’ -> macros
 * 2) Click through to create a new macro using VBA code
 * 3) Replace whatever code you see with the code below
 * 4) Click ‘View’ -> macros
 * 5) Click ‘run’ on the macro called ‘demo’


 * 1) See your embedded hyperlinks turn into Wikipedia friendly reference/citation tags

Code:
Sub Demo With ActiveDocument While .Hyperlinks.Count > 0 .Hyperlinks(1).Range.InsertBefore " " .Hyperlinks(1).Delete Wend End With End Sub

Description
Word2Wiki is a compilation of various Visual Basic code I found lying around the internet. (possibly related to this)

Usage
To use this Microsoft Word to Wiki converter, copy the code below and save it to word2wiki.bas.


 * Open your word document and then hit Alt+F11.
 * Then select File -> Import File.
 * Select the file you have just saved.
 * Close the Visual Basic screen.
 * Then in your Word document select Alt+F8.
 * The convertor will do its job and should automatically copy the conversion into the clipboard.
 * All you then need to do is to paste into your editor in MediaWiki.

This convertor is not perfect and I am not a Visual Basic programmer, so any enhancements or refinements are most welcome.

Code
see the upgrade at Word2MediaWikiPlus or Download the upgrade here.

Option Explicit

Sub Word2Wiki Application.ScreenUpdating = False 'Heading 1 to Heading 5 ConvertParagraphStyle wdStyleHeading1, "== ", " ==" ConvertParagraphStyle wdStyleHeading2, "=== ", " ===" ConvertParagraphStyle wdStyleHeading3, "==== ", " ====" ConvertParagraphStyle wdStyleHeading4, "===== ", " =====" ConvertParagraphStyle wdStyleHeading5, "====== ", " ======" ConvertItalic ConvertBold ConvertUnderline ConvertLists ConvertTables ' Copy to clipboard ActiveDocument.Content.Copy Application.ScreenUpdating = True End Sub Private Sub ConvertParagraphStyle(styleToReplace As WdBuiltinStyle, _                                   preText As String, _                                    postText As String) Dim normalStyle As Style Set normalStyle = ActiveDocument.Styles(wdStyleNormal) ActiveDocument.Select With Selection.Find .ClearFormatting .Style = ActiveDocument.Styles(styleToReplace) .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 .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore preText .InsertAfter postText End If               .Style = normalStyle End With Loop End With End Sub

Private Sub ConvertBold ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Bold = 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.Bold = False .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore "'''" .InsertAfter "'''" End If               .Font.Bold = False End With Loop End With 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 "''" .InsertAfter "''" End If               .Font.Italic = False End With Loop End With End Sub Private Sub ConvertUnderline ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Underline = 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.Underline = False .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore " " .InsertAfter " " End If               .Font.Underline = False End With Loop End With End Sub Private Sub ConvertLists Dim para As Paragraph Dim i As Long For Each para In ActiveDocument.ListParagraphs With para.Range .InsertBefore " " For i = 1 To .ListFormat.ListLevelNumber If .ListFormat.ListType = wdListBullet Then .InsertBefore "*" Else .InsertBefore "#" End If           Next i            .ListFormat.RemoveNumbers End With Next para End Sub Private Sub ConvertTables

Dim myRange As Word.Range Dim tTable As Word.Table Dim tRow   As Word.Row Dim tCell  As Word.Cell Dim strText As String Dim i  As Long Dim j  As Long Dim k  As Long Dim l  As Long For Each tTable In ActiveDocument.Tables 'Memorize table text ReDim x(1 To tTable.Rows.Count, 1 To tTable.Columns.Count) i = 0 For Each tRow In tTable.Rows i = i + 1 j = 0 For Each tCell In tRow.Cells j = j + 1 strText = tCell.Range.Text x(i, j) = Left(strText, Len(strText) - 2) Next tCell Next tRow 'Delete table and position after table Set myRange = tTable.Range myRange.Collapse Direction:=wdCollapseEnd tTable.Delete 'Rewrite table with memorized text myRange.InsertParagraphAfter myRange.InsertAfter ("{| border=1") myRange.InsertParagraphAfter For k = 1 To i               For l = 1 To j                    myRange.InsertAfter " || " + x(k, l)                Next l                myRange.InsertParagraphAfter myRange.InsertAfter "|-" myRange.InsertParagraphAfter Next k           myRange.InsertAfter ("|}") myRange.InsertParagraphAfter Next tTable

End Sub JaredBoone 11:57, 5 January 2006 (UTC)  Word2Wiki  Bug Report: In case the Word document contains a paragraph symbol which is, itself, formatted text, then the Convert&lt;Format&gt; Subs (ConvertBold, ConvertItalics, ConvertUnderline) will enter an infinite loop.

--81.144.178.66 09:55, 27 January 2006 (UTC)Thanks for the fix, I have amended the above code with the changes.

14:11, 9 February 2010 (UTC) Added “dim” statements to the code so that it compiles in Word.

10:36, 11 February 2010 (GMT+1) Refactored + bugfix ConvertTables. In Word 2007, the text was inserted IN the table.

Description
This macro is modified from Word2Wiki above. The modifications are made specifically for Jira markdown language. This has passed basic unit testing against MS Word 2013. Further improvements are welcomed.

Code
Option Explicit ' -- ' Source:      http://www.mediawiki.org/wiki/Microsoft_Word_Macros#Word2Wiki ' Modified by: Sam Koo ' Compatibility:MS Word 2013 and JiraText ' Description: This macro will work with the following formats on word: '              - Bullet points '              - Number list '              - Heading 1 to Heading 4 '              - Bold fonts '              - Italic fonts '              - Simple tables '              - Underline fonts '              - StrikeThroughs '              - Superscript '              - Subscript '              - URLs '              - Monospace fonts (when using Courier New) '              - If the cell has a non-automatic background, '                it will be treated as HEADER row (with ||) ' ---

Sub Word2Jira Application.ScreenUpdating = False ' Remove all formats on SPACEs 'RemoveFormattingOnSpace ' Replace special characters ReplaceSpecialChars 'Heading 1 to Heading 4 ConvertParagraphStyle wdStyleHeading1, "h1. ", "" ConvertParagraphStyle wdStyleHeading2, "h2. ", "" ConvertParagraphStyle wdStyleHeading3, "h3. ", "" ConvertParagraphStyle wdStyleHeading4, "h4. ", "" Dim FontToConvert As New Font 'ConvertItalic FontToConvert.Reset FontToConvert.Italic = True ConvertSpecialFonts FontToConvert, "_", "_" 'ConvertBold FontToConvert.Reset FontToConvert.Bold = True ConvertSpecialFonts FontToConvert, "*", "*" ConvertURLs ' This has to be done before the Underline as URLs will also have underlines 'ConvertUnderline FontToConvert.Reset FontToConvert.Underline = True ConvertSpecialFonts FontToConvert, "+", "+" 'ConvertStrikeThrough FontToConvert.Reset FontToConvert.StrikeThrough = True ConvertSpecialFonts FontToConvert, "-", "-" 'ConvertSuperscript FontToConvert.Reset FontToConvert.Superscript = True ConvertSpecialFonts FontToConvert, "^", "^" 'ConvertSubscript FontToConvert.Reset FontToConvert.Subscript = True ConvertSpecialFonts FontToConvert, "~", "~" 'ConvertCourierNew FontToConvert.Reset FontToConvert.Name = "Courier New" ConvertSpecialFonts FontToConvert, "" ConvertLists ConvertTables ' Copy to clipboard ActiveDocument.Content.Copy Application.ScreenUpdating = True End Sub

Private Sub RemoveFormattingOnSpace With Selection.Find .ClearFormatting

.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.Underline = False .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) .Font.Superscript = False .Font.Subscript = False .Font.StrikeThrough = False .Font.Bold = False .Font.Italic = False .Font.Underline = False .Font.Name = "Arial"

End With Loop End With End Sub

Private Sub ReplaceSpecialChars Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[" .Replacement.Text = "\[" .Forward = True .Wrap = wdFindContinue .Format = True .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 = True .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 = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub Private Sub ConvertParagraphStyle(styleToReplace As WdBuiltinStyle, _                                   preText As String, _                                    postText As String) Dim normalStyle As Style Set normalStyle = ActiveDocument.Styles(wdStyleNormal) ActiveDocument.Select With Selection.Find .ClearFormatting .Style = ActiveDocument.Styles(styleToReplace) .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 .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore preText .InsertAfter postText End If               .Style = normalStyle End With Loop End With End Sub

Private Sub ConvertSpecialFonts(SearchFont As Font, strBefore As String, strAfter As String) ActiveDocument.Select With Selection.Find .ClearFormatting If SearchFont.Superscript = True Then .Font.Superscript = True ElseIf SearchFont.Subscript = True Then .Font.Subscript = True ElseIf SearchFont.StrikeThrough = True Then .Font.StrikeThrough = True ElseIf SearchFont.Bold = True Then .Font.Bold = True ElseIf SearchFont.Italic = True Then .Font.Italic = True ElseIf SearchFont.Underline <> wdUnderlineNone Then .Font.Underline = True ElseIf SearchFont.Name = "Courier New" Then .Font.NameAscii = "Courier New" End If

.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.Underline = False .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore strBefore .InsertAfter strAfter End If               '.Font.StrikeThrough = False If SearchFont.Superscript = True Then .Font.Superscript = False ElseIf SearchFont.Subscript = True Then .Font.Subscript = False ElseIf SearchFont.StrikeThrough = True Then .Font.StrikeThrough = False ElseIf SearchFont.Bold = True Then .Font.Bold = False ElseIf SearchFont.Italic = True Then .Font.Italic = False ElseIf SearchFont.Underline = True Then .Font.Underline = False ElseIf SearchFont.Name = "Courier New" Then .Font.Name = "Arial" End If           End With Loop End With End Sub

Private Sub ConvertURLs

ActiveDocument.Select Dim link, i   'Loop through all hyperlinks. For i = 1 To ActiveDocument.Hyperlinks.Count ActiveDocument.Hyperlinks(1).TextToDisplay = "[" + ActiveDocument.Hyperlinks(1).TextToDisplay + "|" + ActiveDocument.Hyperlinks(1).Address + "]" ActiveDocument.Hyperlinks(1).Delete Next End Sub Private Sub ConvertLists Dim para As Paragraph Dim i As Long For Each para In ActiveDocument.ListParagraphs With para.Range .InsertBefore " " For i = 1 To .ListFormat.ListLevelNumber If .ListFormat.ListType = wdListBullet Then .InsertBefore "*" Else .InsertBefore "#" End If           Next i            .ListFormat.RemoveNumbers End With Next para End Sub Private Sub ConvertTables

Dim myRange As Word.Range Dim tTable As Word.Table Dim tRow   As Word.Row Dim tCell  As Word.Cell Dim strText As String Dim i  As Long Dim j  As Long Dim k  As Long Dim l  As Long For Each tTable In ActiveDocument.Tables 'Memorize table text ReDim x(1 To tTable.Rows.Count, 1 To tTable.Columns.Count) ReDim Z(1 To tTable.Rows.Count, 1 To tTable.Columns.Count) i = 0 For Each tRow In tTable.Rows i = i + 1 j = 0 For Each tCell In tRow.Cells j = j + 1 strText = tCell.Range.Text x(i, j) = Left(strText, Len(strText) - 2) If tTable.Rows(i).Cells(j).Shading.BackgroundPatternColor <> wdColorAutomatic Then 'Row begins with any specific colour - treat as header row Z(i, j) = 1 Else '0 means non-header rows Z(i, j) = 0 End If               Next tCell Next tRow 'Delete table and position after table Set myRange = tTable.Range myRange.Collapse Direction:=wdCollapseEnd tTable.Delete 'Rewrite table with memorized text For k = 1 To i               For l = 1 To j                    If Z(k, l) = 1 Then myRange.InsertAfter "|" End If                   'If k = 1 Then '   myRange.InsertAfter "|" 'End If                   myRange.InsertAfter "| " + x(k, l)                Next l

myRange.InsertAfter "|" 'If k = 1 Then '   myRange.InsertAfter "|" 'End If               If Z(k, j) = 1 Then myRange.InsertAfter "|" End If               myRange.InsertParagraphAfter Next k           'myRange.InsertParagraphAfter Next tTable End Sub

Word2TWiki
JaredBoone

Description
Word2TWiki is a TWiki version of Word2Wiki (see above), with added support for greater than and less than symbols, and for BoldItalic formatted text. Note: You must remove the empty lines from numerical lists or TWiki will re-number the list elements starting after each empty line.

Usage

 * Copy the code below to your clipboard.
 * Paste it into a text editor and save it to word2twiki.bas.
 * In Word, open the document you want to convert.
 * Start Visual Basic (Alt+F11).
 * In Visual Basic, select File -> Import File (Ctrl+M).
 * In the Import File dialog, browse to and select word2twiki.bas.
 * Run the macro, either in Visual Basic (F5), or in Word (Alt+F8).

Code
Sub Word2TWiki Application.ScreenUpdating = False ConvertH1 ConvertH2 ConvertH3 'First look for Bold + Italic... ConvertBoldItalic '...Then look for just Italic and just Bold ConvertItalic ConvertBold

'First convert LT and GT... ConvertLessThan ConvertGreaterThan '...Then convert underlines ConvertUnderline ConvertLists ConvertTables ' Copy to clipboard ActiveDocument.Content.Copy Application.ScreenUpdating = True End Sub

Private Sub ConvertH1 Dim normalStyle As Style Set normalStyle = ActiveDocument.Styles(wdStyleNormal) ActiveDocument.Select With Selection.Find .ClearFormatting .Style = ActiveDocument.Styles(wdStyleHeading1) .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 .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore "---+++" End If               .Style = normalStyle End With Loop End With End Sub

Private Sub ConvertH2 Dim normalStyle As Style Set normalStyle = ActiveDocument.Styles(wdStyleNormal) ActiveDocument.Select With Selection.Find .ClearFormatting .Style = ActiveDocument.Styles(wdStyleHeading2) .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 .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore "---++++" End If               .Style = normalStyle End With Loop End With End Sub

Private Sub ConvertH3 Dim normalStyle As Style Set normalStyle = ActiveDocument.Styles(wdStyleNormal) ActiveDocument.Select With Selection.Find .ClearFormatting .Style = ActiveDocument.Styles(wdStyleHeading3) .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 .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore "---+++++" End If               .Style = normalStyle End With Loop End With End Sub

Private Sub ConvertBoldItalic 'Note: This Sub should be called BEFORE the ConvertBold and ConvertItalic Subs are called.

ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Italic = True .Font.Bold = 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.Bold = False .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 "__" .InsertAfter "__" End If               .Font.Italic = False .Font.Bold = False End With Loop End With End Sub

Private Sub ConvertBold ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Bold = 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.Bold = False .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore "*" .InsertAfter "*" End If               .Font.Bold = False End With Loop End With 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

.Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore "_" .InsertAfter "_" End If               .Font.Italic = False End With Loop End With End Sub

Private Sub ConvertUnderline ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Underline = 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.Underline = False .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore " " .InsertAfter " " End If               .Font.Underline = False End With Loop End With End Sub

Private Sub ConvertLessThan ActiveDocument.Select Options.ReplaceSelection = True With Selection.Find .ClearFormatting .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 .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .TypeText Text:="&amp;lt;" End If           End With Loop End With End Sub

Private Sub ConvertGreaterThan ActiveDocument.Select Options.ReplaceSelection = True With Selection.Find .ClearFormatting .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 .Collapse .MoveEndUntil vbCr End If               ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .TypeText Text:="&amp;gt;" End If           End With Loop End With End Sub

Private Sub ConvertLists Dim para As Paragraph For Each para In ActiveDocument.ListParagraphs With para.Range If .ListFormat.ListType = wdListBullet Then .InsertBefore "* " For i = 1 To .ListFormat.ListLevelNumber .InsertBefore "  " Next i           Else .ListFormat.ConvertNumbersToText End If           .InsertBefore "   " .ListFormat.RemoveNumbers End With Next para End Sub

Private Sub ConvertTables Dim thisTable As Table For Each thisTable In ActiveDocument.Tables With thisTable .Range.InsertBefore "||" .Range.InsertAfter "||" .ConvertToText "|" End With Next thisTable End Sub

Word macros
See also: Open Office macros (French), Word macros (Esperanto)

Here are some macros to use in Word for editing Wikipedia articles.

WikiLink
Sub WikiLink ' adds double square brackets around the selected text Selection.InsertAfter "]]" Selection.InsertBefore "[[" End Sub

wp_wiki_table
Sub wp_wiki_table Dim wpTable As Table Dim wpRange As Range For Each wpTable In ActiveDocument.Tables Dim i As Integer Dim j As Integer For i = 1 To wpTable.Rows.Count For j = 1 To wpTable.Columns.Count Selection.Find.ClearFormatting If i = 1 Then wpTable.Cell(i, j).Range.InsertBefore "!" Else wpTable.Cell(i, j).Range.InsertBefore "|" End If            If j = 1 Then If i = 1 Then wpTable.Cell(i, j).Range.InsertBefore "{| border=1 cellspacing=0 " & vbCrLf Else wpTable.Cell(i, j).Range.InsertBefore "|- " & vbCrLf End If            End If             If i = 1 Then wpTable.Cell(i, j).Range.InsertAfter " !" Else If j <> wpTable.Columns.Count Then wpTable.Cell(i, j).Range.InsertAfter " |" End If        Next j '        wpTable.Cell(i, wpTable.Columns.Count).Range.InsertAfter vbCrLf & "|" Next i    wpTable.Cell(wpTable.Rows.Count, wpTable.Columns.Count).Range.InsertAfter vbCrLf & "|} " Set wpRange = wpTable.ConvertToText(Separator:="*") wpRange.Style = wdStylePlainText 'Tests if a line has been left before and after wpTable If wpRange.Start > 1 Then If ActiveDocument.Characters(wpRange.Start - 2) <> Chr(13) Then wpRange.InsertBefore Chr(13) End If    End If '     If ActiveDocument.Characters(wpRange.End + 1) <> Chr(13) Then '        wpRange.InsertAfter Chr(13) '    End If Next wpTable ReplaceAsteriskSeparator End Sub Sub ReplaceAsteriskSeparator 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

wp_table_html
Sub wp_table_html Dim wpTable As Table Dim wpRange As Range For Each wpTable In ActiveDocument.Tables Dim i As Integer Dim j As Integer For i = 1 To wpTable.Rows.Count For j = 1 To wpTable.Columns.Count Selection.Find.ClearFormatting wpTable.Cell(i, j).Range.InsertBefore "&lt;td&gt;" If j = 1 Then wpTable.Cell(i, j).Range.InsertBefore "&lt;tr&gt; " If i = 1 Then wpTable.Cell(i, j).Range.InsertBefore "&lt;table&gt; " End If            End If             wpTable.Cell(i, j).Range.InsertAfter " &lt;/td&gt;" Next j        wpTable.Cell(i, wpTable.Columns.Count).Range.InsertAfter "&lt;/tr&gt; " Next i    wpTable.Cell(wpTable.Rows.Count, wpTable.Columns.Count).Range.InsertAfter "&lt;/table&gt; " Set wpRange = wpTable.ConvertToText(Separator:=" ") wpRange.Style = wdStylePlainText 'teste si une ligne a bien été laissée avant et après le wpTable If wpRange.Start &gt; 1 Then If ActiveDocument.Characters(wpRange.Start - 2) &lt;&gt; Chr(13) Then wpRange.InsertBefore Chr(13) End If    End If     If ActiveDocument.Characters(wpRange.End + 1) &lt;&gt; Chr(13) Then wpRange.InsertAfter Chr(13) End If Next wpTable End Sub

ReadFootNotes (please merge into main code)
This needs to be merged into the main code by someone who knows VB. For now,


 * 1) run the ReadFootNotes macro (below)
 * 2) run the RemoveTabSpace macro (below)
 * 3) run the main Word2Wiki macro. (Testing was carried out successful with an earlier version of Word2Wiki - presumably it also works with Word2MediaWiki.)

Chriswaterguy: Thanks to a friend who is a very competent VB programmer (Amitabh Pathik) we have a way of converting footnotes to MediaWiki markup. I've successfully used it in the past. Now it's just a matter of merging it into a word to wiki macro (which I can't do as I'm running OpenOffice on Linux, which appears to be incompatible with these macros). Amitabh and I both give permission for this code to be used & adapted under whatever open license.

It seems that this has to be run before the other Word to wiki code, or else the other code will delete the footnotes.

ReadFootNotes macro
Amitabh's macro (posted here with permission): Sub ReadFootNotes For Each com In ActiveDocument.Footnotes com.Reference.Select Selection.Font.ColorIndex = wdRed Selection.TypeText Text:=" " Next End Sub

This leaves a tab and space after each   which is not wanted, so I recorded a macro to remove it - "RemoveTabSpace", below. This runs successfully, after the "ReadFootNotes" macro is finished. This will need to be integrated (and possibly the cursor will need to be sent to the beginning of the document first, so that it replaces all in one pass, with no prompts).

RemoveTabSpace macro
Sub RemoveTabSpace ' ' RemoveTabSpace Macro ' Macro recorded 3/05/2007 by user '    Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " " & vbTab & " " .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