Wikipedia:Technik/Text/Basic/OOo Calc2Dokuwiki

Dieses StarOffice-Makro Calc2Dokuwiki (lucsorel.com) konvertiert Tabellen der OpenOffice-Tabellenkalkulation in MediaWiki- oder DokuWiki-Tabellen. Die Konvertierung von writer-Tabellen ist schon in den writer integriert. Dessen Zweckentfremdung zur Konvertierung von calc-Tabellen funktioniert nur eingeschränkt (über Inhalte einfügen im rtf-Format). Dieses Makro konvertiert die Tabellen direkt.

Installation

Bearbeiten

über Extras / Extension Manager / Hinzufügen ...

Konvertierung

Bearbeiten

Über das calc-Menü

Extras/Makros/Makros Verwalten/OpenOffice.org Basic

ein neues Makro anlegen. Dort unten stehenden Code via Zwischenablage eingefügen.

Anwendung

Bearbeiten

Vor dem Makroaufruf die gewünschten Zeilen / Spalten markieren.

Falls nicht alle Zeilen und Spalten benötigt werden, kann vor der Konvertierung eine Filterung erfolgen. Zeilen und Spalten können wie folgt gefiltert werden:

  1. Zeilen mit Autofilter filtern.
  2. Gefilterte Zeilen markieren, kopieren und mit Inhalte einfügen (ohne Formeln) in ein anderes Tabellenblatt einfügen. Dort die nicht benötigten Spalten löschen. Anschließend können die verbleibenden Zellen markiert und mit dem Makro konvertiert werden. Die Selektion sollte nur genau die benötigten Spalten und Zeilen umfassen. Andernfalls entstehen leere Zeilen und Spalten.
REM  *****  Calc2Dokuwiki  *****
' Calc2Dokuwiki is an extension for OpenOffice.org 2.x which converts
' a selection of cells (in Calc, the spreadsheet module) into a table
' in Dokuwiki code. The code of this extension is distributed under
' the LGPL and the CeCILL licenses.
' Copyright (C) 2007  Luc Sorel luc.sorel at gmail.com
' Erweitert von dokuwiki auf mediawiki (C) LoKiLeCh

REM  *****  LGPL  *****
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Lesser General Public
' License as published by the Free Software Foundation; either
' version 2.1 of the License, or (at your option) any later version.
'
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
' Lesser General Public License for more details.
'
' You should have received a copy of the GNU Lesser General Public
' License along with this library; if not, write to the Free Software
' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

REM  *****  CeCILL  *****
' This software is governed by the CeCILL license under French
' law and abiding by the rules of distribution of free software.
' You can use, modify and/or redistribute the software under the
' terms of the CeCILL license as circulated by CEA, CNRS and INRIA
' at the following URL "http://www.cecill.info".
'
' As a counterpart to the access to the source code and rights
' to copy, modify and redistribute granted by the license, users
' are provided only with a limited warranty and the software's author,
' the holder of the economic rights, and the successive licensors have
' only limited liability.
'
' In this respect, the user's attention is drawn to the risks
' associated with loading, using, modifying and/or developing
' or reproducing the software by the user in light of its specific
' status of free software, that may mean that it is complicated
' to manipulate, and that also therefore means that it is reserved
' for developers and experienced professionals having in-depth
' computer knowledge. Users are therefore encouraged to load and
' test the software's suitability as regards their requirements in
' conditions enabling the security of their systems and/or data
' to be ensured and, more generally, to use and operate it in
' the same conditions as regards security.
'
' The fact that you are presently reading this means that you have
' had knowledge of the CeCILL license and that you accept its terms.

option explicit

dim mode as string


function CellStringNFormat(myCell as object) as string
  dim myStrg, myBoldStyle as string
  dim delim as string
  myStrg = myCell.String
  ' If the cell is empty, returns a [space] otherwise Dokuwiki will merges cells in the row
  if mode = "m" then
   delim = "|| "
  else
   delim = "| "
  endif


  if (len(myStrg) = 0) then
    CellStringNFormat = delim
    exit function
  endif
  ' Add text format (bold, italic), underline type (true or false), and horisontal alignment (left, center, right)
  if ((myCell.charWeight = com.sun.star.awt.FontWeight.BOLD) or (myCell.charWeight = com.sun.star.awt.FontWeight.ULTRABOLD)) then myStrg = "**" & myStrg & "**"
  if (myCell.charPosture = com.sun.star.awt.FontSlant.ITALIC) then myStrg = "//" & myStrg & "//"
  if not(myCell.CharUnderline = com.sun.star.awt.FontUnderline.NONE) then myStrg = "__" & myStrg & "__"
  if (myCell.HoriJustify = com.sun.star.table.CellHoriJustify.RIGHT) then myStrg = "  " & myStrg
  if (myCell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER) then myStrg = "  " & myStrg & "  "
  if (myCell.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT) then myStrg = myStrg & "  "
  if (myCell.HoriJustify = com.sun.star.table.CellHoriJustify.STANDARD) then myStrg = "  " & myStrg
  ' Add cell style (heading or standard)

  if mode = "d" then
   if (InStr(myCell.CellStyle,"heading")>0) then
     myStrg = "^" & myStrg
   else
     myStrg = delim & myStrg
   end if
  else
   if (InStr(myCell.CellStyle,"heading")>0) then
     myStrg = "!" & myStrg
   else
     myStrg = delim & myStrg
   end if
  endif

  ' Return Dokuwiki code for the cell
  CellStringNFormat = myStrg
end function

sub writeTableCode(myZone as object, myWriterDocText as object, textCursor as object, optional idSel as integer)
  dim coordZone as object
  dim rowMax, colMax, idCol, idRow as integer
  dim myCellString as string
  dim endParagraph as integer

  endParagraph = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK
  coordZone = myZone.RangeAddress
  colMax = coordZone.EndColumn-coordZone.StartColumn
  rowMax = coordZone.EndRow-coordZone.StartRow

  if (IsMissing(idSel)) then
    myWriterDocText.insertString(textCursor,"Table", false)
  else
    myWriterDocText.insertString(textCursor,"Table " & (idSel+1), false)
  end if
  myWriterDocText.insertControlCharacter(textCursor,endParagraph,false)

  if mode = "m" then
     myWriterDocText.insertString(textCursor, "{|  class=" & chr(34) & "wikitable sortable" & chr(34), false)
     myWriterDocText.insertControlCharacter(textCursor, endParagraph, false)
 endif

  for idRow = 0 to rowMax
    for idCol = 0 to colMax
      myCellString = CellStringNFormat(myZone.getCellByPosition(idCol,idRow))
      if idCol = 0 and mode = "m" then myCellString = right(myCellString,len(myCellString)-1)
      myWriterDocText.insertString(textCursor, myCellString,false)
    next idCol

   if mode = "m" then

   else
     myWriterDocText.insertString(textCursor, "|", false)
    endif

    myWriterDocText.insertControlCharacter(textCursor, endParagraph, false)

 if mode = "m" then
     myWriterDocText.insertString(textCursor, "|-", false)
     myWriterDocText.insertControlCharacter(textCursor, endParagraph, false)
 endif
  next idRow


   if mode = "m" then
     myWriterDocText.insertString(textCursor, "|}", false)
     myWriterDocText.insertControlCharacter(textCursor, endParagraph, false)
 endif

  myWriterDocText.insertControlCharacter(textCursor, endParagraph, false)
end sub

function doesDisplayHelp(myCalcDoc as object) as boolean
  dim myZone, coordZone as object
  dim rowMax, colMax as integer
  dim cellString as string

  myZone = myCalcDoc.CurrentSelection
  if myZone.supportsService("com.sun.star.sheet.SheetCellRanges") then
    ' It's a multiple selection -> do not display help information
    doesDisplayHelp = false
    exit function
  else
    ' Single selection
    coordZone = myZone.RangeAddress
    colMax = coordZone.EndColumn-coordZone.StartColumn
    rowMax = coordZone.EndRow-coordZone.StartRow
    if ((colMax > 0) or (rowMax > 0)) then
      doesDisplayHelp = false
      exit function
    else
      cellString = LCase(myZone.getCellByPosition(0, 0).String)
      if (cellString = "help") then
        doesDisplayHelp = true
        exit function
      else
        doesDisplayHelp = false
        exit function
      endif
    endif
  endif
  doesDisplayHelp = false
end function

Sub Calc2Dokuwiki_Main
  dim myCalcDoc as Object
  dim rowMax, colMax, idCol, idRow, idSel as integer
  dim myCellString as string
  dim propFichier()
  dim myWriterDoc, myWriterDocText, textCursor as object
  dim endParagraph as integer
  dim helpString as string
  mode = inputbox("Bitte geben Sie den gewünschten Dokumententyp an! m für mediawiki d für dokuwiki","Dokumententyp definieren", "m")

  endParagraph = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK
  myCalcDoc = ThisComponent

  if doesDisplayHelp(myCalcDoc) then
    ' Display help information if desired (= one cell selection with word 'help' typed in it, without the quote)
    helpString = "Calc2Dokuwiki converts a selection of cells into a table in Dokuwiki code. The code is generated in a new Writer document ready to be copy-pasted in your Dokuwiki website!"
    helpString = helpString + Chr(13) + Chr(13) + "A multiple selection of cells ouputs as many tables (in the same Writer document) as selections."
    msgBox(helpString,0,"Calc2Dokuwiki - help")
  else
    myWriterDoc = StarDesktop.LoadComponentFromURL("private:factory/swriter","_blank",0,propFichier)
    myWriterDocText = myWriterDoc.Text
    textCursor = myWriterDocText.createTextCursor()

    ' Add help access information at the beginning of the document
    myWriterDocText.insertString(textCursor, "HELP: To read a short user guide about Calc2Dokuwiki extension, type 'help' (without the quotes) in a Calc cell, select this cell, and press the extension button again.", false)
    myWriterDocText.insertControlCharacter(textCursor, endParagraph, false)
    myWriterDocText.insertControlCharacter(textCursor, endParagraph, false)

    ' Parse the Calc selected cells and produce Dokuwiki code
    if myCalcDoc.CurrentSelection.supportsService("com.sun.star.sheet.SheetCellRanges") then
      for idSel = 0 to (myCalcDoc.CurrentSelection.count - 1)
        writeTableCode(myCalcDoc.CurrentSelection(idSel), myWriterDocText, textCursor, idSel)
      next idSel
    else
      writeTableCode(myCalcDoc.CurrentSelection, myWriterDocText, textCursor)
    endif
  end if

End Sub