Wikipedia Diskussion:Technik/Text/Basic/Excel2Wiki

aus Wikipedia, der freien Enzyklopädie
Letzter Kommentar: vor 4 Jahren von Michael Bednarek in Abschnitt English Translation required
Zur Navigation springen Zur Suche springen

Warum Formatierungszeilen?

[Quelltext bearbeiten]

Das mit den Formatierungszeilen erscheint mir reichlich kompliziert. Ist es nicht einfacher, die Formatierung der Excel-Zelle direkt in den Zelleneintrag der Wiki-Tabelle zu übernehmen, z.B.:

   '------------------Hintergrundfarbe der Zelle in Wiki-Tags umsetzen-----------------------------------------
   If Hex(ActiveSheet.Cells(Zeile, Spalte).Interior.Color) <> "FFFFFF" Then
       FormatierungsTags = """" & "style=background-color:#" & Hex(ActiveSheet.Cells(Zeile, Spalte).Interior.Color) & ";" & """"
   Else
       FormatierungsTags = ""
   End If
   '------------------Horizontale Textausrichtung der Zelle in Wiki-Tags umsetzen------------------------------
   If ActiveSheet.Cells(Zeile, Spalte).HorizontalAlignment = xlCenter Then
       FormatierungsTags = "align=" & """" & "center" & """" & FormatierungsTags
   End If
   If ActiveSheet.Cells(Zeile, Spalte).HorizontalAlignment = xlRight Then
       FormatierungsTags = "align=" & """" & "right" & """" & FormatierungsTags
   End If
-- Hundase 08:27, 30. Aug 2005 (CEST)


Verbesserungsvorschläge

[Quelltext bearbeiten]

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

[Quelltext bearbeiten]

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.


  • "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)

Fehlermeldung beim ausführen

[Quelltext bearbeiten]

Ich habe Excel 2003, bin genau den Anweisungen gefolgt. Beim starten des Makros erschein mir folgende Fehlermeldung:

Fehler beim Kompilieren. 
Syntaxfehler

und das wird mir markiert:

<nowiki>Print #fHandle, "{| {{prettytable-R}}"</nowiki>

-- Mabba 16:26, 28. Dez. 2007 (CET)Beantworten

Alternatives Makro

[Quelltext bearbeiten]
Hier gibt es einen Link zu einem Makro, das bei mir funktioniert hat.

http://de.wikipedia.org/wiki/Wikipedia:Textverarbeitung/EXCEL-Tabellenumwandlung

--Hubert Klüpfel 20:40, 28. Jan. 2008 (CET)Beantworten


Funktion unter Office 2007/2010

[Quelltext bearbeiten]

Das Makro ist echt klasse. Funktioniert bei mir bis Office 2003 problemlos. Ab Office 2007 und auch im Office 2010 funktioniert es nicht mehr. Gibt es dafür eine Lösung? Gruß --Schaffi 18:49, 23. Sep. 2010 (CEST)Beantworten

Lösung für Excel 2010

[Quelltext bearbeiten]

Leider hat sich da ein wenig was geändert in den letzten Versionen, daher hier mal meine funkionierende Lösung:

  • Die gewünschte Datei öffnen.
  • Sicherstellen, dass das Ribbon "Entwicklertools" aktiv ist.
    Falls nicht:
    • Auf das Ribbon "Datei gehen"
    • Menüpunkt "Optionen" wählen
    • Im jetzt offenen Fenster den Menüpunkt "Menüband anpassen" wählen
    • in der rechten liste den Haken bei "Entwicklertools" setzen.
    • Fenster mit "OK" schließen
  • Im Ribbon "Entwicklertools" die Schaltfläche "Visual Basic" anklicken.
  • Im neuen Fenster (VBA-Editor) links im oberen Kasten "VBAProjekt" anwählen
  • Menüreiter "Einfügen" den Punkt "Modul" wählen
  • In den freien Bereich (rechts) den kompletten (!) VBA-Code hineinkopieren (s.u.)
  • Speichern (Diskettensymbol anklicken)
  • Das Fenster schließen.
  • Im Ribbon "Entwicklertools" die Schaltfläche "Makros" anklicken.
  • Im oberen Feld "E2W" eingeben und "Erstellen" anklicken
  • In dem Bereich (rechts) zwischen "Sub E2W()" und "End Sub" die nachfolgende Zeile einfügen:
Call Excel2Wiki(Application.ActiveSheet.Name, Application.ActiveSheet.Name) 'Blattname, Tabellenkopf


Das sollte dann so aussehen:
Sub E2W()
    Call Excel2Wiki(Application.ActiveSheet.Name, Application.ActiveSheet.Name)  'Blattname, Tabellenkopf
End Sub


  • Speichern (Diskettensymbol anklicken)
  • Das Fenster schließen.
    • Auf das Ribbon "Datei gehen"
    • Menüpunkt "Optionen" wählen
    • Im jetzt offenen Fenster den Menüpunkt "Symbolleiste für den Schnellzugriff" wählen
    • Linkes Auswahlfeld auf "Makro" stellen
    • Linke Seite "E2W" auswählen und "Hinzufügen" klicken
    • Fenster mit "OK" schließen



Der nachfolgende Code ist weitestgehend unverändert. Angepasst wurde primär das neue Filehandling.

 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

    Dim fso
    Dim fs
    
    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

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fs = fso.CreateTextFile(DateiName, True)


    ZeilenText = Str(EndSpalte + 1 - StartSpalte)
    fs.writeline "<!-- |colspan=""" & ZeilenText & """ align=""center"" -->"
    ZeilenText = Str(EndZeile + 1 - StartZeile)
    fs.writeline "<!-- |rowspan=""" & ZeilenText & """ align=""center"" -->"
    fs.writeline "{| {{prettytable-R}}"
    fs.writeline "|+ " & 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 = "True" 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

        fs.writeline ZeilenText
        fs.writeline "|-"
        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)
    fs.writeline "|colspan=""" & ZeilenText & """|<small>Anmerkung: </small>"
    fs.writeline "|}"
    fs.Close

 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

English Translation required

[Quelltext bearbeiten]

Greetings , I hope we can adding English support for this application --Omda4wady (Diskussion) 13:13, 24. Feb. 2020 (CET)Beantworten

Or you may want to try https://tools.wmflabs.org/excel2wiki/ instead. -- Michael Bednarek (Diskussion) 14:02, 24. Feb. 2020 (CET)Beantworten