Microsoft Word Macros

Word2MediaWikiPlus
An improvement over Word2MediaWiki.

See mw:Extension:Word2MediaWikiPlus.

Note that some people find Word2MediaWikiPlus harder to install and use.

Word2MediaWiki
All text taken from: http://www.infpro.com/Word2MediaWiki.aspx The source code of this macro has a lot in common with Word2Wiki, but has some additions.

Description
Convert Microsoft Word document content to MediaWiki markup. This is a Word Visual Basic macro. Usage requires a running copy of Microsoft Word that supports Visual Basic macros. (Word 97 or greater).

Features

 * Replaces smart quotes/double-quotes with dumb equivalents
 * Escapes the following characters: * # { } [ ] ~ ^^ | '
 * Converts external hyperlinks
 * Converts H1-H5 headings
 * Converts bold/italic/underline/strikethrough/superscript/subscript formatting
 * Converts bulleted/numbered lists
 * Converts simple tables.

Code Location
The source code can be found at http://www.infpro.com/download.asp?file=Files%5CWord2MediaWiki%5CWord2MediaWiki.bas

Some tweaks
Replace the EscapeCharacter function with this one: Private Function EscapeCharacter(char As String) ReplaceString char, "  " & char & "   " End Function

other Word styles to some sort of MediaWiki format, use something like this: Private Sub MediaWikiConvertChapterTitle ReplaceHeading "Chapter Title", "=" End Sub Where Chapter Title is the literal name of the Word style with the same name.

Description
Word2Wiki is a compliation 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.

Attribute VB_Name = "Word2Wiki"

Sub Word2Wiki Application.ScreenUpdating = False ConvertH1 ConvertH2 ConvertH3 ConvertItalic ConvertBold 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 "==" .InsertAfter " ==" 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 "===" .InsertAfter " ===" 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 "====" .InsertAfter " ====" 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 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 oTable As Table For Each oTable In ActiveDocument.Tables With oTable ReDim x(1 To oTable.Rows.Count, 1 To oTable.Columns.Count) i = 0 For Each a In oTable.Rows i = i + 1 j = 0 For Each b In a.Cells j = j + 1 strText = b.Range.Text x(i, j) = Left(strText, Len(strText) - 2) Next b       Next a        .Range.InsertParagraphAfter .Range.InsertAfter ("{| border=1") .Range.InsertParagraphAfter For k = 1 To i           For l = 1 To j               .Range.InsertAfter " || " + x(k, l)               '.Range.InsertParagraphAfter Next .Range.InsertParagraphAfter .Range.InsertAfter "|-" .Range.InsertParagraphAfter Next .Range.InsertAfter ("|}") .Range.InsertParagraphAfter End With Next oTable 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 ammeded the above code with the changes.

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

WikiWord
WikiWord is a template for Microsoft Word which is useful both for converting an existing document to Wiki syntax (bold, headings, etc.), and for writing new pages in Wiki syntax. It is based on a conversion template for SPIP.

To install this, copy the file "WikipediaX.dot" (X is the version number) into Word's template folder. To convert, simply click the button "Wikipeedia" in the default Wikipedia toolbar.

Important: It is necessary to disable the automatic conversion of apostrophes (') to typographical ones (’) (select the menu Tools, then follow AutoCorrection > AutoFormat As You Type  and unselect Straight quotes with smart quotes). Alternatively, you can convert the typographical apostrophes back to simple ones yourself.

Aoineko

Features

 * Convert italic to  italic 
 * Convert bold to  bold 
 * Convert italic&bold to  italic&bold 
 * Convert  underline  to  underline 
 * Convert "point lists" to WikiList (*</tt>, **</tt>, ***</tt>, etc.)
 * Convert "numerical lists" to WikiList (#</tt>, ##</tt>, ###</tt>, etc.)
 * Convert "table" to WikiTable ( {| ... |} </tt>)

Version 0.4
File: fr:Media:Wikipedia4.dot 

Version 0.51
File: fr:Media:Wikipedia51.dot (Description and history)

What's new:
 * Converts lists using * and #
 * Converts tables to Wiki syntax
 * Editing aids: bold, italics, images, links, headings (1, 2, 3)
 * New toolbar

Known bugs:
 * Sometimes the font styles (bold, italics, etc.) are placed at a line break. In such a case it is not necessary to create Wiki syntax. (Translator's note: I'm sorry, I don't know what the original author of this sentence meant. &mdash; Timwi 03:57, 28 Jun 2004 (UTC))

Version 0.52
File: fr:Media:Wikipedia52.dot (Description and history)

What's new:
 * New toolbar icons
 * Automatically selects the word around the cursur when nothing is selected when you click a toolbar button

Known bugs:
 * Like 0.51 with the styles at line breaks.

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 'teste si une ligne a bien été laissée avant et après le 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