Wikiup:Technik/Text/Basic/Excel2Wiki

aus Wikipedia, der freien Enzyklopädie
Ähnliche Programme

VBA-Code für Microsoft Excel. Damit kann jede Excel-Tabelle sofort ohne Umwege in eine Textdatei geschrieben werden, welche dann im Wiki einfach nur eingefügt werden muss.

Vorversion; funktioniert nur bis Excel 2003. Excel 2007 und höher werden nicht unterstützt.

Funktionsumfang

  • ...
  • Berücksichtigung von verbundenen Zellen
  • Möglichkeit der Drehung einer Tabelle und der Zeilenumkehr. – Auch möglich durch: BEARBEITEN > INHALT EINFÜGEN (Option TRANSPONIEREN), sofern diese Funktion zur Verfügung steht.

Anleitung zum VBA-Makro

Im Prinzip: Einfach in einem Modul im VBA-Editor einfügen und starten.
Die folgende Anleitung kann für andere Excel-Versionen leicht abweichen:

  1. Mit Excel die Datei öffnen, die umgewandelt werden soll
  2. Den VBA-Editor öffnen (Menü: Extras/Makro/Visual-Basic-Editor) oder 'Alt-F11'
  3. In der linken Spalte sind die geöffneten Dokumente angezeigt
  4. Dort auf 'VBA-Projekt’ (mit dem Namen des aktuellen Dokuments, also nicht bei Eurotools!) mit der rechten Maustaste hinklicken
  5. Im Kontextmenü Einfügen/Modul wählen
  6. Im rechten großen Fenster erscheint eine leere weiße Seite (evtl. steht oben Option Explicit)
  7. Den gesamten Quelltext unten kopieren und auf diese leere weisse Seite einfügen
  8. Das Makro ausführen (Die Variablen Startspalte, Startzeile, Endspalte, Endzeile und Dateiname werden automatisch bei jedem Start abgefragt)

Könnte mal jemand hiereinschreiben, wie man das Makro in Excel 2003 ausführt? --> ist ein hässlicher Hack, aber funktioniert auf die Schnelle: Ersetze 

Sub Excel2Wiki(Blatt, Kopf As String)

durch 

Sub Excel2Wiki()
   Dim Blatt, Kopf As String

und füge vor StartZelle = InputBox("Ab ... folgendes ein: 

   Blatt = InputBox("Welches Tabellenblatt soll umgewandelt werden ?", _
                           "Tabellenblatt - Schritt 0 von 4", "Tabelle1")

Danach lässt sich das Makro mit Alt-F8 aufrufen.

VBA-Makro zum Kopieren

 Option Explicit
 'Hier sind 3 Programme:
 'Erstens die Umwandlung Excel-Tabelle in wiki-Format
 'Zweitens die Drehung einer Tabelle Zeilen in Spalten und umgekehrt (Zelle A1 bleibt Zelle A1)
 'Drittens die Reihenfolge der Zeilen umzudrehen (erste Zeile wird letzte)

 'Schritte zum Einbinden am Beginn der Unterprogramme
 Const maxa = 100     'maximale Zahl der Tabellen
 Global Numm As Integer
 Global switch, schon As Integer


 Sub Excel2Wiki(Blatt, Kopf As String)
    Dim fHandle, i, j, k, pos, mehr As Integer
    Dim StartZeile, EndZeile As Integer
    Dim StartSpalte, EndSpalte As Integer
    Dim ZeilenText, ZellInhalt, DateiName, Formatierungstags As String
    Dim StartZelle, EndZelle, DateiPfad, typf, hilf As String
    Dim mzeil, mspal, mzahl, mmzeil As Integer
    Dim inhalt As Object

    fHandle = FreeFile()
    Formatierungstags = "" 'bisher noch nicht eingebaut

    'Hinweise zur Nutzung: Aus dem Excel-Blatt mit [Alt] + [F11] Visual Basic aufrufen.
    'Ggf. mit Einfügen einen Modul einfügen.
    'Dieses VBA-Programm in einen Modul kopieren und
    'die nachfolgende Zeile in die Zwischenablage übernehmen:
    '  Call Excel2Wiki(CommandButton1.Parent.Name, CommandButton1.Parent.Name)  'Blattname, Tabellenkopf
    'Danach auf dem Excel-Tabellenblatt im Pull-down-Menü Ansicht den
    'Punkt "Symbolleisten" anklicken und dann "Steuerelement Toolbox" anklicken
    'Anschließend auf der Symbolleiste "Steuerelement Toolbox" den
    'Button "Befehlsschaltfläche" (linke Spalte, 4.Element von oben) anklicken
    'Mit der Maus an die geünschte Stelle gehen und das bei der Mausbewegung
    'entstehende Rechteck auf die
    'gewünschte Größe ziehen und die Maustaste loslassen.
    'Anschließend auf der Symbolleiste "Steuerelement Toolbox" den
    'Button "Code anzeigen" (linke Spalte, 2.Element von oben) anklicken und
    'anschließend in den erscheinenden Code zwischen "Private Sub ..." und "End Sub" die
    'Zeile der Zwischenablage übernehmen (bei der kopierten Zeile erstes "'" löschen.
    'Ggf. diesen Stand schon speichern.
    'Wenn gewünscht Symbolleiste "Steuerelement Toolbox" schließen
    'Anschließend die Zahlen in der Zeile 2 entsprechend Ihrer Tabelle anpassen. Die
    'Bedeutung steht in Zeile 1 in der Reihenfolge (Spaltenbuchstaben in Anführungszeichen einschließen).
    'Beim Drücken der neuen Befehlsschaltfläche wird die Excel-Tabelle im wiki-Format
    'ausgegeben und zwar auf der nachfolgenden Datei - ggf. anpassen.
    'Danach ist ggf. noch ein Feinschliff der Tabelle notwendig.
    'Als Hilfsmittel für den Feinschliff sind noch colspan und rowspan
    'als Kommentar angegeben:
    'Die Zahlenwerte müssen angepaßt werden und die Zeile an die entsprechende Stelle kopiert werden
    '(entsprechend Felder löschen)

    StartZelle = InputBox("Ab welcher Zelle (links oben) soll umgewandelt werden ?", _
                            "Startzeile - Schritt 1 von 4", "A1")
    EndZelle = InputBox("Bis zu welcher Zelle (rechts unten) soll umgewandelt werden ?", _
                            "Endzeile - Schritt 2 von 4", "N24")
    DateiPfad = InputBox("Wie soll die Ausgabepfad heissen?", _
                            "Dateiname - Schritt 3 von 4", "C:\")
    Kopf = InputBox("Text Tabellenkopf", _
                            "Kopf - Schritt 3 von 4", Kopf)

    DateiName = DateiPfad & Blatt & ".txt"

    StartSpalte = adre(CStr(StartZelle))
    StartZeile = Numm
    EndSpalte = adre(CStr(EndZelle))
    EndZeile = Numm

    Open DateiName For Output As #fHandle
    ZeilenText = Str(EndSpalte + 1 - StartSpalte)
    Print #fHandle, "<!-- |colspan=""" & ZeilenText & """ align=""center"" -->"
    ZeilenText = Str(EndZeile + 1 - StartZeile)
    Print #fHandle, "<!-- |rowspan=""" & ZeilenText & """ align=""center"" -->"
    Print #fHandle, "{| {{prettytable-R}}"
    Print #fHandle, "|+ " & Kopf

    switch = 0
    schon = 0
    For i = StartZeile To EndZeile
        ZeilenText = "|"
        mehr = 0

        For j = StartSpalte To EndSpalte
            If mehr = 1 Then ZeilenText = ZeilenText & "||"
            mehr = 1
            typf = Worksheets(Blatt).Cells(i, j).NumberFormat
            ZellInhalt = Worksheets(Blatt).Cells(i, j)
            If ZellInhalt = Empty Then ZellInhalt = "&nbsp;"

            If Worksheets(Blatt).Cells(i, j).MergeCells = "Wahr" Then
                mzeil = Worksheets(Blatt).Cells(i, j).MergeArea.Row
                mspal = Worksheets(Blatt).Cells(i, j).MergeArea.Column
                mzahl = Worksheets(Blatt).Cells(i, j).MergeArea.Count
                If mspal = j Then
                    k = 1
                    While ((j + k) <= EndSpalte) And (Worksheets(Blatt).Cells(i, j + k).MergeArea.Column = j)
                        k = k + 1 ' Zähler hochzählen.
                    Wend    'While-Schleife beenden
                    If j + k = EndSpalte Then If Worksheets(Blatt).Cells(i, j + k).MergeArea.Column = j Then k = k + 1
                    j = j + k - 1
                    If mzeil = i Then
                        hilf = CStr(k)
                        ZeilenText = ZeilenText & "colspan=""" & hilf & """ align=""center"""
                        mmzeil = CInt(mzahl / k)
                        If mmzeil > 1 Then
                            hilf = CStr(mmzeil)
                            ZeilenText = ZeilenText & " rowspan=""" & hilf & """"
                        End If
                        ZeilenText = ZeilenText & "|" & ZellInhalt
                    Else
                        mehr = 0
                    End If
                Else
                    GoTo nichts2
                End If
            Else
                Select Case typf
                    Case "@"
                    Case Else: ZellInhalt = wandeln(CStr(ZellInhalt))
                End Select
                ZeilenText = ZeilenText & Formatierungstags & ZellInhalt
            End If


            If 1 = 2 Then
            If 1 = 2 Then
 nichts2:
            End If
            End If

        Next j

        Print #fHandle, ZeilenText
        Print #fHandle, "|-"
        ZeilenText = ""
        If schon = 0 Then
            switch = 0
        Else
            i = i - 1
            switch = switch + 1
            schon = 0
        End If
    Next i

    ZeilenText = Str(EndSpalte + 1 - StartSpalte)
    Print #fHandle, "|colspan=""" & ZeilenText & """|<small>Anmerkung: </small>"
    Print #fHandle, "|}"
    Close #fHandle

 End Sub
 '
 Sub drehen(Blatt As String)
    Dim Blatt1, nam(maxa), meld, EndZelle As String
    Dim spal, hn, i, j, naz(maxa), EndZeile As Integer

    'Hinweise zur Nutzung: Aus dem Excel-Blatt mit [Alt] + [F11] Visual Basic aufrufen.
    'Ggf. mit Einfügen einen Modul einfügen.
    'Dieses VBA-Programm in einen Modul kopieren und
    'die nachfolgende Zeile in die Zwischenablage übernehmen:
    '   Call drehen(CommandButton1.Parent.Name) 'Blattname, Zelle A1 bleibt Zelle A1
    'Danach auf dem Excel-Tabellenblatt im Pull-down-Menü Ansicht den
    'Punkt "Symbolleisten" anklicken und dann "Steuerelement Toolbox" anklicken
    'Anschließend auf der Symbolleiste "Steuerelement Toolbox" den
    'Button "Befehlsschaltfläche" (linke Spalte, 4.Element von oben) anklicken
    'Mit der Maus an die geünschte Stelle gehen und das bei der Mausbewegung
    'entstehende Rechteck auf die
    'gewünschte Größe ziehen und die Maustaste loslassen.
    'Anschließend auf der Symbolleiste "Steuerelement Toolbox" den
    'Button "Code anzeigen" (linke Spalte, 2.Element von oben) anklicken und
    'anschließend in den erscheinenden Code zwischen "Private Sub ..." und "End Sub" die
    'Zeile der Zwischenablage übernehmen (bei der kopierten Zeile erstes "'" löschen.
    'Ggf. diesen Stand schon speichern.
    'Wenn gewünscht Symbolleiste "Steuerelement Toolbox" schließen
    'Anschließend die Zahlen in der Zeile 2 entsprechend Ihrer Tabelle anpassen. Die
    'Bedeutung steht in Zeile 1 in der Reihenfolge (Spaltenbuchstaben in Anführungszeichen einschließen).
    'Beim Drücken der neuen Befehlsschaltfläche wird ein neues Tabellenblatt angelegt und
    'die Excel-Tabelle gedreht in die neue Tabelle kopiert
    'Danach ist ggf. noch ein Feinschliff der Tabelle notwendig.

    Blatt1 = Left(Blatt, Len(Blatt) - 1) & "-dreh"

    hn = Worksheets.Count
    If hn > maxa - 1 Then
        i = MsgBox(meld, , "zuviele Blätter - Abbruch")
        Exit Sub
    End If
    For i = 1 To hn
        If Worksheets(i).Name = Blatt1 Then
            i = MsgBox(meld, , "neues Blatt schon vorhanden - Abbruch")
            Exit Sub
        End If
        nam(i) = Worksheets(i).Name
    Next i
    Worksheets.Add
    For i = 1 To hn + 1
        naz(i) = 0
    Next i
    For i = 1 To hn
        For j = 1 To hn + 1
            If Worksheets(j).Name = nam(i) Then naz(j) = i
        Next j
    Next i
    j = 0
    For i = 1 To hn + 1
        If naz(i) = 0 Then
            Worksheets(i).Name = Blatt1
            j = 1
            Exit For
        End If
    Next i
    If j = 0 Then
        i = MsgBox(meld, , "Blatt konnte nicht benannt werden - Abbruch")
        Exit Sub
    End If

    EndZelle = InputBox("Bis zu welcher Zelle (rechts unten) soll gedreht werden ?", _
                            "Endzelle: ", "N24")

    hn = adre(CStr(EndZelle))
    EndZeile = Numm

    For i = 1 To EndZeile
        For j = 1 To hn
            Worksheets(Blatt1).Cells(j, i) = Worksheets(Blatt).Cells(i, j)
        Next j
    Next i
 End Sub
 '
 Sub kehrt(Blatt)
    Dim Blatt1, nam(maxa), meld, EndZelle As String
    Dim spal, hn, i, j, EZ, naz(maxa), EndZeile As Integer

    'Hinweise zur Nutzung: Aus dem Excel-Blatt mit [Alt] + [F11] Visual Basic aufrufen.
    'Ggf. mit Einfügen einen Modul einfügen.
    'Dieses VBA-Programm in einen Modul kopieren und
    'die nachfolgende Zeile in die Zwischenablage übernehmen:
    '   Call kehrt(CommandButton1.Parent.Name)  'Blattname
    'Danach auf dem Excel-Tabellenblatt im Pull-down-Menü Ansicht den
    'Punkt "Symbolleisten" anklicken und dann "Steuerelement Toolbox" anklicken
    'Anschließend auf der Symbolleiste "Steuerelement Toolbox" den
    'Button "Befehlsschaltfläche" (linke Spalte, 4.Element von oben) anklicken
    'Mit der Maus an die geünschte Stelle gehen und das bei der Mausbewegung
    'entstehende Rechteck auf die
    'gewünschte Größe ziehen und die Maustaste loslassen.
    'Anschließend auf der Symbolleiste "Steuerelement Toolbox" den
    'Button "Code anzeigen" (linke Spalte, 2.Element von oben) anklicken und
    'anschließend in den erscheinenden Code zwischen "Private Sub ..." und "End Sub" die
    'Zeile der Zwischenablage übernehmen (bei der kopierten Zeile erstes "'" löschen.
    'Ggf. diesen Stand schon speichern.
    'Wenn gewünscht Symbolleiste "Steuerelement Toolbox" schließen
    'Anschließend die Zahlen in der Zeile 2 entsprechend Ihrer Tabelle anpassen. Die
    'Bedeutung steht in Zeile 1 in der Reihenfolge (Spaltenbuchstaben in Anführungszeichen einschließen).
    'Beim Drücken der neuen Befehlsschaltfläche wird ein neues Tabellenblatt angelegt und
    'die Excel-Tabelle gedreht in die neue Tabelle kopiert
    'Danach ist ggf. noch ein Feinschliff der Tabelle notwendig.

    Blatt1 = Left(Blatt, Len(Blatt) - 1) & "-kehr"

    hn = Worksheets.Count
    If hn > maxa - 1 Then
        i = MsgBox(meld, , "zuviele Blätter - Abbruch")
        Exit Sub
    End If
    For i = 1 To hn
        If Worksheets(i).Name = Blatt1 Then
            i = MsgBox(meld, , "neues Blatt schon vorhanden - Abbruch")
            Exit Sub
        End If
        nam(i) = Worksheets(i).Name
    Next i
    Worksheets.Add
    For i = 1 To hn + 1
        naz(i) = 0
    Next i

    EndZelle = InputBox("Bis zu welcher Zelle (rechts unten) soll umgedreht werden ?", _
                            "Endzelle: ", "N24")

    For i = 1 To hn
        For j = 1 To hn + 1
            If Worksheets(j).Name = nam(i) Then naz(j) = i
        Next j
    Next i
    j = 0
    For i = 1 To hn + 1
        If naz(i) = 0 Then
            Worksheets(i).Name = Blatt1
            j = 1
            Exit For
        End If
    Next i
    If j = 0 Then
        i = MsgBox(meld, , "Blatt konnte nicht benannt werden - Abbruch")
        Exit Sub
    End If

    hn = adre(CStr(EndZelle))
    EndZeile = Numm

    EZ = EndZeile
    For i = 1 To EZ
        For j = 1 To EZ
            Worksheets(Blatt1).Cells(EZ + 1 - i, j) = Worksheets(Blatt).Cells(i, j)
        Next j
    Next i
 End Sub
 '
 Function adre(h0 As String) As Integer
    'Feldadresse in zwei Zahlen verwandeln
        'Eingabe:
            'hi: Feldadresse (Spalte als Buchstaben, Zeile als Zahl)
        'Ausgabe
            'adre: Spaltennummer als Zahl, Numm als Zeilenadresse
    On Error GoTo ErrorHandler  ' Fehlerbehandlung aktivieren.

    Dim meld, spa, spa1, spah, hi As String
    Dim hz, i, hh, hl As Integer

    spa = Left(h0, 1)
    If IsNumeric(spa) Then
        meld = "erstes Zeichen von " & h0 & "ist kein Spaltenbuchstabe - Abbruch"
        hi = MsgBox(meld, , "Fehlermeldung")
        End
    End If
    hi = Mid(h0, 2)

    spa1 = Left(hi, 1)
    If IsNumeric(spa1) Then
        spa1 = ""
        If Not IsNumeric(hi) Then
            meld = h0 & "ist keine Zellenadresse - Abbruch"
            hi = MsgBox(meld, , "Fehlermeldung")
            End
        End If
        Numm = CInt(hi)
    Else
        spa = spa & spa1
        spa1 = ""
        hi = Mid(hi, 2)
        If Not IsNumeric(hi) Then
            meld = h0 & "ist keine Zellenadresse - Abbruch"
            hi = MsgBox(meld, , "Fehlermeldung")
            End
        End If
        Numm = CInt(hi)
    End If

    hi = spa & spa1
    If IsNumeric(hi) And (Not IsEmpty(hi)) Then
        adre = CInt(hi)
    Else
        hz = Len(hi)
        hl = 0
        Select Case hz
        Case 1
            hh = Asc(hi) - 64
            If hh > 58 Then GoTo Falsch
            If hh > 26 Then hh = hh - 32
            If hh > 26 Then GoTo Falsch
        Case 2
            hl = Asc(Mid(hi, 2, 1)) - 64
            If hh > 58 Then GoTo Falsch
            If hh > 26 Then hh = hh - 32
            If hh > 26 Then GoTo Falsch
        Case Else
 Falsch:
            meld = h0 & "ist keine Zellenadresse"
            hi = MsgBox(meld, , "Fehlermeldung")
            End
        End Select
        adre = hl * 26 + hh
    End If
 Exit Function

 ErrorHandler:
    meld = "In Funktion adre"
    meld = meld & " ist Fehler " & Err.Number
    meld = meld & " aufgetreten. Deswegen Rechnungsabbruch"
    i = MsgBox(meld, , "Fehlermeldung")
    End

 End Function

 Function wandeln(was As String) As String
    Dim pos, k As Integer

    If (was = " ") Or (was = "") Then was = "&nbsp;"

            If IsNumeric(was) Then
                was = Format(was)
                pos = InStr(was, ",")
                If pos > 0 Then
                    was = Left(was, pos + 2)
                    If Len(was) = pos Then was = was & "&nbsp;&nbsp;"
                    If Len(was) = pos + 1 Then was = was & "&nbsp;"
                Else
                    was = was & "&nbsp;&nbsp;&nbsp;"
                End If
            End If

            If switch > 0 Then
                For k = 1 To switch
                    pos = InStr(was, Chr(10))
                    If pos > 0 Then
                        was = Mid(was, pos + 1)
                    Else
                        was = ""
                    End If
                Next k
            End If
            pos = InStr(was, Chr(10))
            If pos > 0 Then
                was = Left(was, pos - 1)
                schon = switch + 1
            End If

            If was = "" Then was = "&nbsp;"

    wandeln = was

 End Function
Abgerufen von „https://de.wikiup.org/index.php?title=Wikiup:Technik/Text/Basic/Excel2Wiki&oldid=188913788“