The following macro will (crudely) reformat a Microsoft Word document into a WIKI document. Capabilities The following changes are made: * **Heading Level Changes**. A line with style **Heading 1** is converted to a line with **````** on both sides. Similarly for other heading levels. * **Bold**. Bold text is bracketed with ``**``. * **Underline**. Underlined text is bracketed with ``__``. * **Italics**. Italicized text is bracketed with ``//``. * **Tables**. Tables are converted to the appropriate form with ``||`` between columns. \\ Known Issues \\ * Tables with a cell that spans more than one row will produce an error. \\ * Superscripts and subscripts convert to ```` or ```` but that is not supported. \\ * Two or more of the same heading lines (e.g., a Heading Level 1 line followed immediately by another Heading Level 1 line) do not convert correctly. The ```` signs are not placed correctly. \\ * Issues with empty text being bolded ``** **`` is often misinterpreted as a heading 2 and has to be manually cleaned up. \\ Installing the Macro \\ # Open Word. \\ # Click on New Macro (how depends on your version). \\ # Enter **WordToWIKI** as the macro name. \\ # Cut and past the text below, replacing the text that is already there. \\ # Save. \\ Macro \\ [[code_formatvb|code format"vb"]] \\ Public Sub Word2Wiki() \\ Application.ScreenUpdating False \\ ReplaceQuotes \\ MediaWikiEscapeChars \\ MediaWikiConvertHyperlinks \\ MediaWikiConvertH1 \\ MediaWikiConvertH2 \\ MediaWikiConvertH3 \\ MediaWikiConvertH4 \\ MediaWikiConvertH5 \\ MediaWikiConvertItalic \\ MediaWikiConvertBold \\ MediaWikiConvertUnderline \\ MediaWikiConvertStrikeThrough \\ MediaWikiConvertSuperscript \\ MediaWikiConvertSubscript \\ MediaWikiConvertLists \\ MediaWikiConvertTables \\ ' Copy to clipboard \\ ActiveDocument.Content.Copy \\ Application.ScreenUpdating True \\ End Sub \\ Private Sub MediaWikiConvertH1() \\ ReplaceHeading wdStyleHeading1, "" \\ End Sub \\ Private Sub MediaWikiConvertH2() \\ ReplaceHeading wdStyleHeading2, "" \\ End Sub \\ Private Sub MediaWikiConvertH3() \\ ReplaceHeading wdStyleHeading3, "" \\ End Sub \\ Private Sub MediaWikiConvertH4() \\ ReplaceHeading wdStyleHeading4, "" \\ End Sub \\ Private Sub MediaWikiConvertH5() \\ ReplaceHeading wdStyleHeading5, "" \\ End Sub \\ Private Sub MediaWikiConvertBold() \\ 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 Len(.Text) > 1 And 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 ActiveDocument.Styles("Default Paragraph Font") \\ .Font.Bold False \\ End With \\ Loop \\ End With \\ End Sub \\ Private Sub MediaWikiConvertItalic() \\ 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 Len(.Text) > 1 And 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 ActiveDocument.Styles("Default Paragraph Font") \\ .Font.Italic False \\ End With \\ Loop \\ End With \\ End Sub \\ Private Sub MediaWikiConvertUnderline() \\ 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 Len(.Text) > 1 And 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 ActiveDocument.Styles("Default Paragraph Font") \\ .Font.Underline False \\ End With \\ Loop \\ End With \\ End Sub \\ Private Sub MediaWikiConvertStrikeThrough() \\ ActiveDocument.Select \\ With Selection.Find \\ .ClearFormatting \\ .Font.StrikeThrough True \\ .Text "" \\ .Format True \\ .MatchCase False \\ .MatchWholeWord False \\ .MatchWildcards False \\ .MatchSoundsLike False \\ .MatchAllWordForms False \\ .Forward True \\ .Wrap wdFindContinue \\ Do While .Execute \\ With Selection \\ If Len(.Text) > 1 And 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 ActiveDocument.Styles("Default Paragraph Font") \\ .Font.StrikeThrough False \\ End With \\ Loop \\ End With \\ End Sub \\ Private Sub MediaWikiConvertSuperscript() \\ ActiveDocument.Select \\ With Selection.Find \\ .ClearFormatting \\ .Font.Superscript True \\ .Text "" \\ .Format True \\ .MatchCase False \\ .MatchWholeWord False \\ .MatchWildcards False \\ .MatchSoundsLike False \\ .MatchAllWordForms False \\ .Forward True \\ .Wrap wdFindContinue \\ Do While .Execute \\ With Selection \\ .Text Trim(.Text) \\ If Len(.Text) > 1 And 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 ActiveDocument.Styles("Default Paragraph Font") \\ .Font.Superscript False \\ End With \\ Loop \\ End With \\ End Sub \\ Private Sub MediaWikiConvertSubscript() \\ ActiveDocument.Select \\ With Selection.Find \\ .ClearFormatting \\ .Font.Subscript True \\ .Text "" \\ .Format True \\ .MatchCase False \\ .MatchWholeWord False \\ .MatchWildcards False \\ .MatchSoundsLike False \\ .MatchAllWordForms False \\ .Forward True \\ .Wrap wdFindContinue \\ Do While .Execute \\ With Selection \\ .Text Trim(.Text) \\ If Len(.Text) > 1 And 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 ActiveDocument.Styles("Default Paragraph Font") \\ .Font.Subscript False \\ End With \\ Loop \\ End With \\ End Sub \\ Private Sub MediaWikiConvertLists() \\ 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 MediaWikiConvertTables() \\ Dim thisTable As Table \\ For Each thisTable In ActiveDocument.Tables \\ With thisTable \\ For Each aRow In thisTable.Rows \\ With aRow \\ For Each aCell In aRow.Cells \\ With aCell \\ aCell.Range.InsertBefore "|| " \\ 'aCell.Range.InsertAfter " |" \\ End With \\ Next aCell \\ 'aRow.Range.InsertBefore "|" \\ aRow.Range.InsertAfter " ||" ' + vbCrLf End With Next aRow '.Range.InsertBefore "|" '.Range.InsertAfter "|" + vbCrLf .ConvertToText "" End With Next thisTable End Sub Private Sub MediaWikiConvertHyperlinks() Dim hyperCount As Integer hyperCount ActiveDocument.Hyperlinks.Count For i 1 To hyperCount With ActiveDocument.Hyperlinks(1) Dim addr As String addr .Address .Delete If InStr(addr, "@") > 1 Then .Range.InsertBefore "[[mailto:" Else .Range.InsertBefore "[[http://" End If .Range.InsertAfter "|" & addr & "]]" End With Next i End Sub ' Replace all smart quotes with their dumb equivalents Private Sub ReplaceQuotes() Dim quotes As Boolean quotes Options.AutoFormatAsYouTypeReplaceQuotes Options.AutoFormatAsYouTypeReplaceQuotes False ReplaceString ChrW(8220), """" ReplaceString ChrW(8221), """" ReplaceString "‘", "'" ReplaceString "’", "'" Options.AutoFormatAsYouTypeReplaceQuotes quotes End Sub Private Sub MediaWikiEscapeChars() 'EscapeCharacter "*" 'EscapeCharacter "#" 'EscapeCharacter "_" 'EscapeCharacter "-" 'EscapeCharacter "+" 'EscapeCharacter "{" 'EscapeCharacter "}" 'EscapeCharacter "[" 'EscapeCharacter "]" EscapeCharacter "~" EscapeCharacter "^^" 'EscapeCharacter "|" 'EscapeCharacter "'" End Sub Private Function ReplaceHeading(styleHeading As String, headerPrefix As String) Dim normalStyle As Style Set normalStyle ActiveDocument.Styles(wdStyleNormal) ActiveDocument.Select With Selection.Find .ClearFormatting .Style ActiveDocument.Styles(styleHeading) .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 headerPrefix .InsertBefore vbCr .InsertAfter headerPrefix End If .Style normalStyle End With Loop End With End Function Private Function EscapeCharacter(char As String) ReplaceString char, "\" & char End Function Private Function ReplaceString(findStr As String, replacementStr As String) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text findStr .Replacement.Text replacementStr .Forward True .Wrap wdFindContinue .Format False .MatchCase False .MatchWholeWord False .MatchWildcards False .MatchSoundsLike False .MatchAllWordForms False End With Selection.Find.Execute Replace:wdReplaceAll End Function