This is an old revision of the document!


Attribute VB_Name = “Word2DokuWikiv3”

Sub Word2DokuWiki()

  Application.ScreenUpdating = False
  ReplaceQuotes
  DokuWikiEscapeChars
  DokuWikiConvertHyperlinks
  DokuWikiConvertH1
  DokuWikiConvertH2
  DokuWikiConvertH3
  DokuWikiConvertH4
  DokuWikiConvertH5
  DokuWikiConvertItalic
  DokuWikiConvertBold
  DokuWikiConvertUnderline
  DokuWikiConvertStrikeThrough
  DokuWikiConvertSuperscript
  DokuWikiConvertSubscript
  DokuWikiConvertLists
  DokuWikiConvertTable
  UndoDokuWikiEscapeChars
  ' Copy to clipboard
 ActiveDocument.Content.Copy
 Application.ScreenUpdating = True

End Sub

Private Sub DokuWikiConvertH1()

  ReplaceHeading wdStyleHeading1, "======"

End Sub

Private Sub DokuWikiConvertH2()

  ReplaceHeading wdStyleHeading2, "====="

End Sub

Private Sub DokuWikiConvertH3()

  ReplaceHeading wdStyleHeading3, "===="

End Sub

Private Sub DokuWikiConvertH4()

      ReplaceHeading wdStyleHeading4, "==="

End Sub

Private Sub DokuWikiConvertH5()

  ReplaceHeading wdStyleHeading5, "=="

End Sub

Private Sub DokuWikiConvertH6()

  ReplaceHeading wdStyleHeading5, "="

End Sub

Private Sub DokuWikiConvertBold()

  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
                  If Not Left(.Text, 2) = "**" Then
                  .InsertBefore "**"
                  End If
                  If Not Right(.Text, 2) = "**" Then
                  .InsertAfter "**"
                  End If
              End If
             
              .Style = ActiveDocument.Styles("Default Paragraph Font")
              .Font.Bold = False
          End With
      Loop
  End With

End Sub

Private Sub DokuWikiConvertItalic()

  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
                  If Not Left(.Text, 2) = "//" Then
                  .InsertBefore "//"
                  End If
                  If Not Right(.Text, 2) = "//" Then
                  .InsertAfter "//"
                  End If
              End If
             
              .Style = ActiveDocument.Styles("Default Paragraph Font")
              .Font.Italic = False
          End With
      Loop
  End With

End Sub

Private Sub DokuWikiConvertUnderline()

  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
                  If Not Left(.Text, 2) = "__" Then
                  .InsertBefore "__"
                  End If
                  If Not Right(.Text, 2) = "__" Then
                  .InsertAfter "__"
                  End If
              End If
              
              .Style = ActiveDocument.Styles("Default Paragraph Font")
              .Font.Underline = False
          End With
      Loop
  End With

End Sub

Private Sub DokuWikiConvertStrikeThrough()

  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
                  If Not Left(.Text, 2) = "<del>" Then
                  .InsertBefore "<del>"
                  End If
                  If Not Right(.Text, 2) = "</del>" Then
                  .InsertAfter "</del>"
                  End If
              End If
             
              .Style = ActiveDocument.Styles("Default Paragraph Font")
              .Font.StrikeThrough = False
          End With
      Loop
  End With

End Sub

Private Sub DokuWikiConvertSuperscript()

  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
                  If Not Left(.Text, 2) = "<sup>" Then
                  .InsertBefore "<sup>"
                  End If
                  If Not Right(.Text, 2) = "</sup>" Then
                  .InsertAfter "</sup>"
                  End If
              End If
              
              .Style = ActiveDocument.Styles("Default Paragraph Font")
              .Font.Superscript = False
          End With
      Loop
  End With

End Sub

Private Sub DokuWikiConvertSubscript()

  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
                  If Not Left(.Text, 2) = "<sub>" Then
                  .InsertBefore "<sub>"
                  End If
                  If Not Right(.Text, 2) = "</sub>" Then
                  .InsertAfter "</sub>"
                  End If
              End If
             
              .Style = ActiveDocument.Styles("Default Paragraph Font")
              .Font.Subscript = False
          End With
      Loop
  End With

End Sub

Private Sub DokuWikiConvertLists()

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

End Sub

Private Sub DokuWikiConvertHyperlinks()

  Dim hyperCount As Integer
 
  hyperCount = ActiveDocument.Hyperlinks.Count
 
  For i = 1 To hyperCount
      With ActiveDocument.Hyperlinks(1)
          Dim addr As String
          addr = .Address
          .Delete
          .Range.InsertBefore "["
          .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 DokuWikiEscapeChars()

  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 Sub DokuWikiConvertTable() Dim TotTables As Long Do While ActiveDocument.Tables.Count() > 0 ActiveDocument.Tables(1).Range.Select Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “ $s$|$s$ ” .Replacement.Text = “I” .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “ $s$^^$s$ ” .Replacement.Text = “/\” .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Application.DefaultTableSeparator = “|” Selection.Rows.ConvertToText Separator:=wdSeparateByDefaultListSeparator, NestedTables:=True Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “^p” .Replacement.Text = “|^p|” .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.InsertBefore (“|”) Selection.InsertParagraphAfter Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “^p|^p” .Replacement.Text = “^p” .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “$s$blank$s$” .Replacement.Text = “” .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “||” .Replacement.Text = “| |” .Forward = True .Wrap = wdFindStop .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 = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “| |” .Replacement.Text = “| |” .Forward = True .Wrap = wdFindStop .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 = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Paragraphs(1).Range.Select Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = “|” .Replacement.Text = “^^” .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Loop End Sub Private Sub UndoDokuWikiEscapeChars()

  UndoEscapeCharacter "*"
  UndoEscapeCharacter "#"
  UndoEscapeCharacter "_"
  UndoEscapeCharacter "-"
  UndoEscapeCharacter "+"
  UndoEscapeCharacter "{"
  UndoEscapeCharacter "}"
  UndoEscapeCharacter "["
  UndoEscapeCharacter "]"
  UndoEscapeCharacter "~"
  UndoEscapeCharacter "^^"
  UndoEscapeCharacter "|"
  UndoEscapeCharacter "'"

End Sub

Private Function EscapeCharacter(char As String)

  ReplaceString char, " $s$" & char & "$s$ "

End Function

Private Function UndoEscapeCharacter(char As String)

  ReplaceString " $s$" & char & "$s$ ", 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


Personal Tools