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.
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:
- 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öffnetet 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 grossen Fenster erscheint eine leere weisse 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)
VBA-Makro
VORSICHT: Dies hier ist eine veraltete Version! auf [2] gibt es eine überarbeitete Version.
Schau auch bitte unter Diskussion dort wird es bald mehr Infos geben. 14:21Uhr 07.07.2005
'Delimeter & Formatierungstags
Const TabellenBeginn = "{|"
Const TabellenEnde = "|}"
Const ZeilenStartDelimeter = "|"
Const ZeilenEndDelimeter = ""
Const ZeilenTrennzeichen = "|-"
Const Delimeter = "||" 'SpaltenTrennzeichen
Const Formatierungstags = "" 'bisher noch nicht eingebaut
'-----------------------------------------------------
Sub Tabelle2Wiki()
Dim fHandle, i, j As Integer
Dim StartZeile, StartSpalte, EndZeile, EndSpalte As Integer
Dim ZeilenText, ZellInhalt, zeichenkette As String
fHandle = FreeFile()
StartZeile = Val(InputBox("Ab welcher Zeile soll umgewandelt werden ?", _
"Startzeile - Schritt 1 von 5", "1"))
'nach belieben als Zahl eintragen a=1, z=26
StartSpalte = Val(InputBox("Ab welcher Spalte soll umgewandelt werden ?" + _
vbCrLf + "(z.B. A=1, Z=26, AG=33)", _
"Startspalte - Schritt 2 von 5", "1"))
EndZeile = Val(InputBox("Bis zu welcher Zeile soll umgewandelt werden ?", _
"Endzeile - Schritt 3 von 5", "100"))
'nach belieben als Zahl eintragen a=1, z=26, Spalte AG = z+7=33
EndSpalte = Val(InputBox("Bis zu welcher Spalte soll umgewandelt werden ?" + _
vbCrLf + "(z.B. A=1, Z=26, AG=33)", _
"Endspalte - Schritt 4 von 5", "26"))
DateiName = InputBox("Wie soll die Ausgabedatei heissen (bitte ggf. den Pfad ergänzen) ?", _
"Dateiname - Schritt 5 von 5", "wiki-tabelle.txt")
ZeilenText = ""
Open DateiName For Output As #fHandle
Print #fHandle, TabellenBeginn 'Beginn der Tabelle
For i = StartZeile To EndZeile
ZeilenText = ZeilenText + ZeilenStartDelimeter 'Beginn der zeile
For j = StartSpalte To EndSpalte
ZellInhalt = ZelleLesen(i, j)
'leere Zellen mit " " füllen (sonst keine richtige Darstellung im wiki)
If ZellInhalt = "" Then ZellInhalt = " "
If ZellInhalt = Val(ZellInhalt) Then ZellInhalt = Format(ZellInhalt)
If Formatierungstags <> "" Then
ZeilenText = ZeilenText + "|" + Formatierungstags + "|"
ElseIf j > StartSpalte Then 'Die erste Spalte umgehen
ZeilenText = ZeilenText + Delimeter
End If
ZeilenText = ZeilenText + ZellInhalt
Next j
If j < EndSpalte Then
Print #fHandle, ZeilenText + Delimeter
Else
Print #fHandle, ZeilenText + ZeilenEndDelimeter
End If
ZeilenText = ""
Print #fHandle, ZeilenTrennzeichen
Next i
Print #fHandle, TabellenEnde 'Ende der Tabelle
Close #fHandle
End Sub
Function ZelleLesen(Zeile,Spalte)
'OfficeTyp=OfficeHerauskriegen()
'If OfficeTyp= "Excel" Then
'Das geht bisher nur mit Excel, noch nicht mit Staroffice/OpenOffice.org
ZelleLesen = Cells(Zeile, Spalte)
'Else if OfficeTyp = "OpenOffice.org" Then
' Staroffice / OpenOffice.org - Code bitte hierher
'End If
End Function
'Function OfficeHerauskriegen()
'Das müsste auch noch entwickelt werden
'End Function
Entwicklung
Verbesserungsvorschläge
Was noch verbessert werden könnte:
- Es findet noch keine Prüfung des Zellinhalts auf ungültige Zeichen statt
- Durch eine führende Zeile könnten Formatierungsanweisungen angegeben werden, die dann automatisch eingetragen werden
- eine weitere führende Zeile könnte ein Flag enthalten, ob diese Spalte überhaupt übernommen werden soll
- Es fehlt noch das Kopieren der gesamten umgewandelten Tabelle ins Clipboard
- vermutlich sollte ein erneutes einlesen der gesamten Datei und dann eine Kopierfunktion ausreichen
- Verwendung von Option Explicit und überprüfung der Variablennamen :-)
Das hier ist schon relativ konkret durchdacht, aber noch nicht umgesetzt:
- Zellinhalt wird (bisher nur) auf "|" überprüft und ggf. mit <nowiki> umklammert
- Einbau von Formatierungsinformationen:
- Das Makro überprüft das Vorhandensein von 3 Kopfzeilen in der gewählten Exceltabelle.
- Falls die Kopfzeilen noch nicht existieren, werden sie automatisch eingetragen.
- Tabellen-Zeile 1:
- "Mediawiki-Tabelle, diese Zeile ist eine Markierung und dient zur Erkennung des Makros. In den folgenden 2 Zeilen befinden sollten Formatierungsangeben eingetragen werden."
- Tabellen-Zeile 2, mit den Formatierungsanweisungen, ob und wie die Zelle formatiert werden soll
- ist die Zelle leer, wird die Spalte nicht mitübernommen
- "L" =Zellendaten in dieser Spalte werden als [Link] umgewandelt
- "LX" =Zellendaten in dieser Spalte werden als [Link|(Inhalt von Spalte X)] umschrieben, z.B. "L4" macht dann aus "A122" [Abenteuer:Die_Dunkle_Halle|A122], sofern in Spalte 4 derselben Zeile "Die_Dunkle_Halle" steht.
- Tabellen-Zeile 3, mit den Farbinformationen, die dann für jede Zelle dieser Spalte gelten:
- z.B. bgcolor=#aabbaa
- Mit einem Zusatzbuchstaben kann alternierende Farbe erreicht werden (=jede 2.Zeile etwas dunkler),
- z.B. Abgcolor=#ffbbee (=1 Farbwert dunkler) bzw. Bbgcolor=#22aaff (=2 Farbwerte dunkler) ergibt dann
| alternierend #ffbbee | bzw. #22aaff |
| und #eeaacc | mit Farbwechsel zu: #0088cc |
| alternierend #ffbbee | oder #22aaff |
| und #eeaacc | mit Farbwechsel zu: #0088cc |
Portierung auf OpenOffice / StarOffice
Anscheinend ist die Funktion "Cells()" das einzige, was umgeschrieben werden müsste, damit der Makro unter OpenOffice bzw. StarOffice funktioniert.
So weit ich das bisher überblicke, müsste es mit einem UnoService programmiert werden.
Vielleicht kann jemand mal das Handbuch zu OpenOffice-Basic durchschauen und das Problem lösen.
Das hier ist schon mal lauwarm, glaube ich:
Sheet is the module that contains spreadsheet services. It is used like the text service, since it needs a document to work with:
Global oDesktop As Object
Global oDocument As Object
Sub sheetdoc_init
Dim mNoArgs()
REM Empty Sequence
Dim sUrl As String
oDesktop = createUnoService("com.sun.star.frame.Desktop")
sUrl = "private:factory/scalc"
REM Or: sUrl = "file:///home/testuser/Office52/work/table.sdc"
oDocument = oDesktop.LoadComponentFromURL(sUrl,"_blank",0,mNoArgs)
End Sub
In the following examples, we will assume you have opened the document as described.
You ll learn how to address cells and ranges of cells, how to navigate through sheets, and how to draw a chart from sheet data.
bzw.
A single cell is adressed like this: Function GetCell (oDocument As Object, _ nSheet As Long, nColumn As Long ,_ nRow As Long) As com.sun.star.table.XCell Dim oSheets As Object Dim oSheet As Object oSheets = oDocument.Sheets() oSheet = oSheets.getByIndex(nSheet) GetCell = oSheet.getCellByPosition (nColumn , nRow) End Function
bzw.
If you have a range of cells, you might want to work with a single cell. This can be achieved with
getCellByPosition(): oCell = oCellRange.getCellByPosition(0,0)
would return the cell at the top left corner of the range. All values passed to getCellByPosition() are relative to the range.
To get the right bottom cell, you d use
nCols = oCellRange.Columns.Count
nRows = oCellRange.Rows.Count
oCell = oCellRange.getCellByPosition(nCols - 1, nRows -1)
Note that we subtract 1 from the number of rows and columns here, because the numbering starts at zero.
bzw.
To summarize: To set the content of a cell to text, you use the String property, to enter a value in a cell, you set the Value property. If you want to put a formula in a cell, you assign it (including the equals sign) to the Formula property. Note that function names must be English if you use the Formula property. T o use functions in your local language, you must use the FormulaLocal property. If you want to know what a cell contains, you can retrieve its Type property: Sub Printinfo (oCell As Object) Dim eType as Long eType = oCell.Type If eType = com.sun.star.table.CellContentType.VALUE Then Print CStr(oCell.Value) Elseif eType = com.sun.star.table.CellContentType.TEXT Then Print oCell.String Elseif eType <> com.sun.star.table.CellContentType.EMPTY Then Print oCell.Formula + "..." + oCell.FormulaLocal Else Print "Cell Is empty" End If End Sub This piece of code simply outputs the content of a cell as a string. If it is a formula, it is shown in the English and the local variant.
Wär schön, wenn sich das mal jemand vornimmt, der sich schon mit OpenOffice / Staroffice auskennt.
Bugs
- "zeichenkette" ist eigentlich überflüssig.
- Bei mir kommt allerdings ein Laufzeitfehler, falls keine zusätzliche Variable deklariert wird.
- Woran das wohl liegt ?
- Die folgende Zeile funktioniert nicht unter Excel 97 und sollte besser so lauten:
'If ZellInhalt = Val(ZellInhalt) Then
ZellInhalt = Format(ZellInhalt)
neue Fassung
Einschließlich Programme zur Drehung der Tabelle und der Zeilenumkehr. --Physikr 13:08, 4. Sep 2006 (CEST)
- Fehler beseitigt und verbundene Zellen richtig berücksichtigt. --Physikr 23:09, 6. Sep 2006 (CEST)
- noch einen Fehler beseitigt bei verbundenen Zellen. --Physikr 11:31, 7. Sep 2006 (CEST)
- Sonderfall letzte Spalte hatte noch einen Fehler. --Physikr 15:28, 7. Sep 2006 (CEST)
- Wie das VBA-Programm einzubinden ist, steht im Kommentar (Textblock) am Anfang. Eine Kommentarzeile beginnt mit '. Beim Kopieren habe ich festgestellt, daß eine Zeile mit (nowiki) geklammert werden mußte, sonst wurde die Zeile aufgelöst. --Physikr 19:19, 11. Sep 2006 (CEST)
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