Jump to content

Microsoft Word Macros

From mediawiki.org
(Redirected from 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

[edit]

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 
     <ref>www.google.com</ref> tags

Code:

[edit]
Sub Demo()
With ActiveDocument
  While .Hyperlinks.Count > 0
    .Hyperlinks(1).Range.InsertBefore "<ref>" & .Hyperlinks(1).Address & "</ref>"
    .Hyperlinks(1).Delete
  Wend
End With
End Sub

Word2Wiki

[edit]

Description

[edit]

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

Usage

[edit]

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

[edit]

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 "<u>"
                    .InsertAfter "</u>"
                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<Format> Subs (ConvertBold, ConvertItalics, ConvertUnderline) will enter an infinite loop.[reply]

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

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.

Word2Jira

[edit]

Description

[edit]

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

[edit]
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

[edit]

JaredBoone

Description

[edit]

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

[edit]
  • 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

[edit]
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 "<u>"
                    .InsertAfter "</u>"
                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:="&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:="&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

[edit]

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

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

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


wp_wiki_table

[edit]
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_wiki_table Example

[edit]
  col1   col2  !
row1   abc   Egypt
row2   Hug!   there you go...

wp_table_html

[edit]
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 "<td>"
            If j = 1 Then
                wpTable.Cell(i, j).Range.InsertBefore "<tr> "
                If i = 1 Then
                    wpTable.Cell(i, j).Range.InsertBefore "<table> "
                End If
            End If
            wpTable.Cell(i, j).Range.InsertAfter " </td>"
        Next j
       
        wpTable.Cell(i, wpTable.Columns.Count).Range.InsertAfter "</tr> "
    Next i
    wpTable.Cell(wpTable.Rows.Count, wpTable.Columns.Count).Range.InsertAfter "</table> "
    
    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

End Sub

Test

[edit]
text1  text2  text3 
text4  text5  text6 

ReadFootNotes (please merge into main code)

[edit]

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

[edit]

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:="<ref>" & com.Range.Text & "</ref>"
   Next

End Sub

This leaves a tab and space after each <ref> 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

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

Notes

[edit]

See also

[edit]
Retrieved from "https://www.mediawiki.org/w/index.php?title=Microsoft_Word_Macros&oldid=6711215"