Word in Wiki konvertieren

Installationsanleitung

Word2Wiki.jpg

Das unten angegebene Makro wird wie folgt in Word installiert:

  • Den Quelltext in eine Textdatei einfügen und unter „word2wiki.bas“ abspeichern
  • Word öffnen und mit Alt+F11 den „Microsoft Visual Basic – Editor“ öffnen
  • Menü Datei > Datei importieren und „word2wiki.bas“ auswählen
  • Das Visual Basic – Fenster schließen

 

 

 

 

Anwendung

  • In das Word-Dokument, in dem man vorher das Makro eingefügt hat, den Text einfügen, den man konvertieren möchte und mit ALT-F8 das Marko starten
  • Der Konvertierer macht jetzt seine Arbeit und kopiert auch automatisch den Wiki-Code in die Zwischenablage. (weil ja das Original überschrieben wird.)

 

Quellcode

Attribute VB_Name = "Word2Wiki"
 
'Online-HTMl to Wiki: http://diberri.dyndns.org/wikipedia/html2wiki/index.html
Sub Word2Wiki()            'Diese Routine ausführen um das aktive Dokument zu konvertieren.
    
    Application.ScreenUpdating = False
 
    ConvertH1
    ConvertH2
    ConvertH3
 
    ConvertItalic
    ConvertBold
    BConvertHyperlinks      'vor Underline da da Hyperlinks in Word underline sind...
    '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 vbCrLf & "== "
                    .InsertAfter " =="
                End If
 
                .Style = normalStyle
            End With
            Selection.Move
        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 vbCrLf & "=== "
                    .InsertAfter " ==="
                End If
 
                .Style = normalStyle
            End With
            Selection.Move
        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 vbCrLf & "==== "
                    .InsertAfter " ===="
                End If
 
                .Style = normalStyle
            End With
            Selection.Move
        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
            Selection.Move
        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
                Selection.Move
            End With
        Loop
    End With
End Sub
 
Private Sub ConvertLists()
   Dim para As Paragraph
    For Each para In ActiveDocument.ListParagraphs
        With para.Range
            .InsertBefore " "
            For i = 1 To .ListFormat.ListLevelNumber
                If .ListFormat.ListType = wdListBullet Or Asc(.ListFormat.ListString) = 63 Or Not BIsNothing(.ListFormat.ListPictureBullet) Then
                    .InsertBefore "*"
                Else
                    .InsertBefore "#"
                End If
            Next i
            .ListFormat.RemoveNumbers
        End With
    Next para
End Sub
 
Private Sub ConvertTables()
    Dim oTable As Table
    For Each oTable In ActiveDocument.Tables
     With oTable
    ReDim x(1 To oTable.Rows.Count, 1 To oTable.Columns.Count)
      i = 0
         For Each a In oTable.Rows
            i = i + 1
            j = 0
            For Each b In a.Cells
                j = j + 1
                strText = b.Range.Text
                x(i, j) = Left(strText, Len(strText) - 2)
            Next b
        Next a
        .Range.InsertParagraphAfter
        .Range.InsertAfter ("{| border=1")
        .Range.InsertParagraphAfter
        For k = 1 To i
            For l = 1 To j
               .Range.InsertAfter " || " + x(k, l)
               '.Range.InsertParagraphAfter
            Next
        .Range.InsertParagraphAfter
            .Range.InsertAfter "|-"
            .Range.InsertParagraphAfter
        Next
        .Range.InsertAfter ("|}")
        .Range.InsertParagraphAfter
    End With
    Next oTable
End Sub
 
Private Sub BConvertHyperlinks()
    Dim hyp As Hyperlink
    Do While ActiveDocument.Hyperlinks.Count > 0
        For Each hyp In ActiveDocument.Hyperlinks
            t = "" & hyp.Address & " " & hyp.TextToDisplay & ""
            hyp.Range.InsertAfter t
            hyp.Range.Delete
        Next
    Loop
End Sub
 
Private Function BIsNothing(ByRef Object, Optional ReturnOnError As Boolean = False) As Boolean
    On Error GoTo Error_
    If Object Is Nothing Then
        BIsNothing = True
    End If
    Exit Function
 
Error_:
    BIsNothing = ReturnOnError
End Function

Quelle

Projekt-Seite: http://en.wikipedia.org/wiki/Help:WordToWiki

Deutsche Übersetzung: http://www.gratis-wiki.com/AktiKon/index.php?title=Word_in_Wiki_Konvertieren

1 Stern2 Sterne3 Sterne4 Sterne5 Sterne

Loading…
Avatar von manuel

AUTOR

manuel