Wikify Word Documents

Beschreibung

Konvertiert ein Word-Dokument in Media-Wiki-Syntax und kopiert das Ergebnis in die Zwischenablage. Beste Ergebnisse erhält man bei der Konvertierung von Dokumenten, die auf Basis von normal.dot erstellt worden sind. Komplexe Formatvorlagen können Schwierigkeiten bereiten (oder wie es so schön in anderen Dokus heißt: ... may cause unpredictable results).

Das ganze ist eine adaptierte Version von http://www.infpro.com/downloads/downloads/wordmedia.htm.

Nach meinen bisherigen Erfahrungen ist damit zu rechnen, dass ca. 80% eines größeren Dokuments ohne Verluste konvertiert werden können. Um eine manuelle Nachbereitung kommt man aber meist nicht rum!

Leistungsumfang

• Esrsetzt einfache anführungszeichen und Gänsefüßchen
• Schliesst folgende Zeichen in <nowiki>...</nowiki>-Tags ein: * # { } [ ] ~ ^^ | '
• Konvertiert externe Hyperlinks
• Konvertiert Überschriften der Stufen 1-5
• Konvertiert fett/kursiv/unterstrichen/durchgestrichen/hochgestellt/tiefgestellte formatierte Zeichen
• Konvertiert Spiegelpunkt- und numerierte Listen
• Konvertiert einfache Tabellen
• Schliesst mit Schriftart "Courier New" formatierte Zeichen in <code>...</code>-Tags ein

Leistungseinschränkungen

• Grafiken/Bilder/Diagramme werden nicht konvertiert
• komplexe Tabellen werden nicht unterstütz(z.B. bei verbundenen Zellen)
• Hyperlinks innerhalb des Dokuments werden nicht konvertiert
• es gibt keine Garantie, dass es läuft ...

Anleitung

• das Wikifizieren ist unbedingt auf einer Kopie des Word-Dokuments durchzuführen, da ein Original ggf. beschädigt/zerstört werden kann. Sagt hinterher nicht, ihr hättet's nicht gewußt ...
• ggf. vorhandene Deckblätter aus dem Dokument löschen (da sinnlos zum Wikifizieren)
• ggf. Inhaltsverzeichnis aus dem Dokument löschen (wird bei sauber gestuften Überschriften von MediaWiki sebständig erstellt)
• ggf. Numerierung der Kapitelüberschriften ausschalten
• diesen Arbeitsstand sichern, falls erneut aufgesetzt werden muß
• nun mit Alt-F11 den Makroeditor öffnen
• über die Menüeinträge Einfügen/Modul ein leeres Modul einfügen
• unten gezeigtes Makro markieren (wie über Browser angezeigt, nicht über den Editor!) und in den Word-Makro-Editor kopieren
• über die Menüeinträge Debuggen/Kompilieren von Project das Modul compilieren
• in das Word-Dokument zurückwechseln
• über Alt-F8 den Makro-Dialog aufrufen
• "Word2MediaWiki" auswählen und und Button "Ausführen" klicken
• ... hoffen und bangen, denn es kann etwas dauerern und ist ungefähr so spannend wie in das Fenster einer Frontladerwaschmaschine zu schauen...
• nachdem nichts mehr zuckt und die Sanduhr verschwunden ist, sollte das Ergebnis in der Windows-Zwischenablage stehen
• ins Wiki wechseln, in den Editor kopieren und "Vorschau zeigen" klicken
• jubeln oder ärgern und die manuelle Nachbearbeitung beginnen

ToDos

• Zeilenumbrüche erhalten, wo diese gewollt sind

VBA-Makro Word2MediaWiki.bas

Sub Word2MediaWiki()
     Application.ScreenUpdating = False
     ReplaceQuotes
     MediaWikiEscapeChars
     MediaWikiConvertHyperlinks
     MediaWikiConvertH1
     MediaWikiConvertH2
     MediaWikiConvertH3
     MediaWikiConvertH4
     MediaWikiConvertH5
     MediaWikiConvertItalic
     MediaWikiConvertBold
     MediaWikiConvertUnderline
     MediaWikiConvertStrikeThrough
     MediaWikiConvertSuperscript
     MediaWikiConvertSubscript
     MediaWikiConvertCourierNew
     MediaWikiConvertLists
     MediaWikiConvertTables
     ' Copy to clipboard
    ActiveDocument.Content.Copy
    ReplaceCRLF
    Application.ScreenUpdating = True
 End Sub
 
 Private Sub MediaWikiConvertH1()
     'LK modifiziert + ein "="
     ReplaceHeading wdStyleHeading1, "=="
 End Sub
 
 Private Sub MediaWikiConvertH2()
     'LK modifiziert + ein "="
     ReplaceHeading wdStyleHeading2, "==="
 End Sub
 
 Private Sub MediaWikiConvertH3()
     'LK modifiziert + ein "="
     ReplaceHeading wdStyleHeading3, "===="
 End Sub
 
 Private Sub MediaWikiConvertH4()
     'LK modifiziert + ein "="
     ReplaceHeading wdStyleHeading4, "====="
 End Sub
 
 Private Sub MediaWikiConvertH5()
     'LK modifiziert + ein "="
     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(wdStyleNormal)
 
                 .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(wdStyleNormal)
 
                 .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 "<u>"
 
                     .InsertAfter "</u>"
 
                 End If
  
                 .Style = ActiveDocument.Styles(wdStyleNormal)
 
                 .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
 
                     'LK modifiziert auf <s>durchgestrichen</s>
                     .InsertBefore "<s>"
 
                     .InsertAfter "</s>"
 
                 End If
 
                 .Style = ActiveDocument.Styles(wdStyleNormal)
 
                 .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
 
                     'LK modifiziert <sup>hochgestellt</sup>
                     .InsertBefore "<sup>"
 
                     .InsertAfter "</sup>"
 
                 End If
 
                  .Style = ActiveDocument.Styles(wdStyleNormal)
 
                 .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
 
                     'LK modifiziert <sub>tiefgestellt</sub>
                     .InsertBefore "<sub>"
 
                     .InsertAfter "</sub>"
 
                 End If
 
                  .Style = ActiveDocument.Styles(wdStyleNormal)
 
                 .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
 
                         .Range.InsertBefore "|"
 
                         .Range.InsertAfter vbCrLf
 
                     End With
 
                 Next aCell
 
                 .Range.InsertBefore "|"
                 .Range.InsertAfter "|-"
 
                 End With
 
             Next aRow
 
         'LK modifiziert + "{{Prettytable}}"
         .Range.InsertBefore "{| {{Prettytable}}" + vbCrLf
 
         .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
 
             .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 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, "<nowiki>" & char & "</nowiki>"
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
Private Sub MediaWikiConvertCourierNew()
    'LK neu eingefuegt

    Dim para As Paragraph
    For Each para In ActiveDocument.ListParagraphs
        With para.Range
            If .Font.Name = "Courier New" Then
               .InsertBefore "<code>"
               .InsertAfter "</code>"
               .Font.Name = "Arial"
            End If
        End With
    Next para

    ActiveDocument.Select

    With Selection.Find

        .ClearFormatting

        .Font.Name = "Courier New"

        .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 "<code>"
                    .InsertAfter "</code>"

                End If

                .Font.Name = "Arial"

            End With

        Loop

    End With

	ReplaceCRLF

End Sub

Private Sub ReplaceCRLF()
    ReplaceString "" & vbCr, "<br />" & vbCr
End Sub