Importieren Ms Word Doc in ein Wiki

Original Macro von Peter Jongsma - siehe auch (engl) here
Original Page text written for MS 2010 by tsangk - on his site: here
//Original (engl) Howto auf [http://community.wikidot.com/howto:import-ms-word-into-wikidot]//

MS Office 2003 (!!)

( MS Office 2007 wird später hier eingetragen)

1. Öffnen Sie das Word 2003 Document das Sie importieren wollen

2. Gehen Sie auf Extras tab - "pull down" bis "Macro"und click auf "Macros" ( Alt+F8)

2. Eingeben Word2Wiki als den Macro Namen und click Anlegen.

2.1 Stellen Sie sicher, das die Documente ausgewählt sind

3. VB Editor Fenster geht auf:

4. Copy&Paste den kompletten VB Code (siehe Unten zum Öffnen) und schließen des Editors

5. Rechts-Klick in das Blaue menü-Band und Auswahl "Visual Basic" für einen Menu-Button

6 Sie haben nun einen "Run Makro" Button - Klick on it!

6.1. Klick on it!

7 Auswhal des gespeicherten Makros "Word2Wiki" - Klick auf RUN

8. Ihr Word Doc ist Kontertiert in die Wikidot Syntax und gespeichert im Copy Buffer

Input:

Output:

9. Erstellen der Wikidot-Seite um den konvertierten text einzufügen

10. Speichern Ihrer ikidot-Seite! Sieh haben nun Ihr Word doc in Wikidot konvertiert.

Der VB ( Visual basic) Code:

Klick um den Code anzuzeigen

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
    ConvertImages

    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 "__"
                    .InsertAfter "__"
                End If

                .Font.Underline = False
            End With
        Loop
    End With
End Sub
Private Sub ConvertImages()
    ActiveDocument.Select

    With Selection.Find
        .ClearFormatting
        .Text = "^g"
        .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
                    .Text = "[[image NEW]]"
                End If
            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 ("S|")
            'myRange.InsertParagraphAfter
            For k = 1 To i
                For l = 1 To j
                    myRange.InsertAfter "||" + x(k, l)
                   ' myRange.InsertAfter " |" + x(k, l)
                Next l
                'myRange.InsertParagraphAfter
                myRange.InsertAfter "||"
                myRange.InsertParagraphAfter
            Next k
            'myRange.InsertAfter ("|E")
            'myRange.InsertParagraphAfter

    Next tTable

End Sub

---

Eingestellt von Helmut_pdorf am 13 Sep 2011 11:59, letzte Änderung von Helmut_pdorf am 13 Sep 2011 12:29
Tags: hilfe import makro vba word

Share it!

Sie wollen darüber auf Ihrem "Tweet" posten? ==>

Rate it up ?

Kommentare: