Wikify Word Documents
From NesevoWiki
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 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