Wikipedia:Technik/Text/Basic/Excel2Wiki

Hinweis: Diese Seite stammt ursprünglich von hier [1]. Damit eine schnellere Entwicklung möglich wird, die im Interesse aller Wikipedianer / Mediawiki-Benutzer ist, habe ich es getrost hier herkopiert. Ausserdem bin ich selbst Urheber des Makro. --AlrikOhnegrund

Nicht ganz mitgekriegt, daß die WP verlassen wird, so daß meine Version mit Umwandeln, Drehen und Umdrehen hier steht. Kann aber hierher verändert und kopiert werden. --Physikr 08:54, 4. Sep 2006 (CEST)

Beschreibung

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

Funktionsumfang

• ...
• Berücksichtigtigung 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 grossen Fenster erscheint eine leere weisse 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?

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", "D:\Eigene Dateien\Wikipedia\")
   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, ""
   ZeilenText = Str(EndZeile + 1 - StartZeile)
   Print #fHandle, ""
   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 = " "
           
           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 & """|Anmerkung: "
   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 = " "
    
           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 & "  "
                   If Len(was) = pos + 1 Then was = was & " "
               Else
                   was = was & "   "
               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 = " "
           
   wandeln = was

End Function