imported>Xf01213: Abarbeitung Wikipedia:WikiProjekt Begriffsklärungsseiten/Arbeitslisten/Top-BKS für Visual Basic

2019-05-24T18:44:03Z

Abarbeitung Wikipedia:WikiProjekt Begriffsklärungsseiten/Arbeitslisten/Top-BKS für Visual Basic

Neue Seite

{{Hilfreiches|1=
* [[../EXCEL-Tabellenumwandlung|EXCEL-Tabellenumwandlung]]
|2=Ähnliche Programme
}}
[[Visual Basic for Applications|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.<br />
Die folgende Anleitung kann für andere Excel-Versionen leicht abweichen:
# Mit Excel die Datei öffnen, die umgewandelt werden soll
# Den VBA-Editor öffnen (Menü: Extras/Makro/Visual-Basic-Editor) oder 'Alt-F11'
# In der linken Spalte sind die geöffneten Dokumente angezeigt
# Dort auf 'VBA-Projekt’ (mit dem Namen des aktuellen Dokuments, also nicht bei Eurotools!) mit der rechten Maustaste hinklicken
# Im Kontextmenü Einfügen/Modul wählen
# Im rechten großen Fenster erscheint eine leere weiße Seite (evtl. steht oben ''Option Explicit'')
# Den gesamten Quelltext unten kopieren und auf diese leere weisse Seite einfügen
# 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
<syntaxhighlight lang="VB">
Sub Excel2Wiki(Blatt, Kopf As String)
</syntaxhighlight>
durch
<syntaxhighlight lang="VB">
Sub Excel2Wiki()
Dim Blatt, Kopf As String
</syntaxhighlight>

und füge vor <code>StartZelle = InputBox("Ab ...</code> folgendes ein:
<syntaxhighlight lang="VB">
Blatt = InputBox("Welches Tabellenblatt soll umgewandelt werden ?", _
"Tabellenblatt - Schritt 0 von 4", "Tabelle1")
</syntaxhighlight>

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

== VBA-Makro zum Kopieren ==
<syntaxhighlight lang="VB">
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, ""
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 & """|<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 = " "

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
</syntaxhighlight>

[[Kategorie:Wikipedia:Technik/Text|Excel2Wiki]]

Wikipedia:Technik/Text/Basic/Excel2Wiki - Versionsgeschichte

imported>Xf01213: Abarbeitung Wikipedia:WikiProjekt Begriffsklärungsseiten/Arbeitslisten/Top-BKS für Visual Basic