You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
293 lines
8.5 KiB
293 lines
8.5 KiB
REM ***** BASIC ***** |
|
|
|
'**************************************************************** |
|
'** Go through a calc sheet and convert rows to a JSON export |
|
'** file with formatting converted to HTML. |
|
'** |
|
'** Formatting that is exported: |
|
'** |
|
'** * Bold |
|
'** * Italics |
|
'** * Text color |
|
'** |
|
'** @version 1.1 2018-10-12 |
|
'** @package DRDB |
|
'** @copyright Copyright (c) 2014-19 Martin Sauter |
|
'** @license GNU General Public License |
|
'** @since Since Release 1.0 |
|
'** |
|
'** |
|
'** Version History |
|
'** |
|
'** 1.0 2018-08-06 - Initial Version |
|
'** |
|
'** 1.1 2019-10-12 - Definition of an array that contains the |
|
'** lines to exclude and after which to advance |
|
'** the ID counter to the start ID of a new |
|
'** category. |
|
'** |
|
'** |
|
'** |
|
'**************************************************************** |
|
|
|
'All variables must be declared! |
|
Option Explicit |
|
|
|
|
|
'**************************************************************** |
|
' |
|
' ADAPT the following contants before starting the JSON export |
|
' procedure. |
|
' |
|
'**************************************************************** |
|
|
|
Const OUTPUT_FILENAME = "~/Desktop/json-export-data.txt" |
|
|
|
'Starting at 1000000000 because the first line is a category line that |
|
'makes the start_id jump right to 1001000000 |
|
Const START_ID = 1000000000 |
|
|
|
'Number of add to START_ID for the beginning of the next |
|
'category ID. Used in combination with the NEW_CATEGORY_LINES array |
|
Const CATEGORY_RANGE = 1000000 |
|
|
|
'Which sheet to export, the numbering starts at 1 |
|
Const SHEET = 1 |
|
|
|
'Last column (=field) to be exported. Numbering starts at 1 |
|
'(as shown in Calc) |
|
Const LAST_COLUMN = 9 |
|
|
|
'First and last row to be exported. Row numbers as shown in Calc! |
|
'(i.e. first line would be 1 and NOT 0!) |
|
'Note: The first line MUST contain the field names as the |
|
'php input function compares them with the php config file |
|
Const FIRST_ROW = 1 |
|
Const LAST_ROW = 30 |
|
|
|
'A sheet may have lines after which a new category (e.g. decade starts) |
|
'This array contains the line numers (declared in MAIN below) |
|
'which trigger an advance based on START_ID and CATEGORY_RANGE |
|
'IMPORTANT: The lines declared in this arry are IGNORED and are NOt |
|
'put into the JSON output! |
|
' |
|
'Values have to be written into this array in main, please modify |
|
'there!!! |
|
Dim NEW_CATEGORY_LINES |
|
|
|
'Which columns (=fields) to ignore for the export. Starts at 1 |
|
'Values have to be written into this array in MAIN, please modify |
|
'there!!! |
|
Dim IGNORE_COLUMNS |
|
|
|
'**************************************************************** |
|
' |
|
' Main routine to convert one or more Calc sheets |
|
' |
|
'**************************************************************** |
|
|
|
|
|
Sub Main |
|
|
|
Dim FileNo As Integer |
|
Dim Doc as Object |
|
Dim x as Integer |
|
|
|
|
|
FileNo = Freefile |
|
Open OUTPUT_FILENAME For Output As #FileNo |
|
|
|
'define which columns to ignore |
|
'IGNORE_COLUMNS = Array(2,5,6) |
|
IGNORE_COLUMNS = Array() |
|
|
|
'Declare which lines start a new category (and which are then ignored) |
|
NEW_CATEGORY_LINES = Array(2) |
|
|
|
Doc = ThisComponent |
|
|
|
' JSON structure starts with a curly brace |
|
Print #FileNo, "{" + chr(13) |
|
|
|
ConvertAllLinesInSingleSheet (FileNo, Doc, SHEET - 1, START_ID) |
|
|
|
' JSON structure ends with a curly brace |
|
Print #FileNo, "}" + chr(13) |
|
|
|
Close #FileNo |
|
|
|
End Sub |
|
|
|
|
|
'**************************************************************** |
|
'** |
|
'** This function loops over all lines in one sheet of the calc |
|
'** file, extracts all records and puts them into the output file |
|
'** |
|
'** |
|
'**************************************************************** |
|
Function ConvertAllLinesInSingleSheet (FileNo, Doc, SheetNum, StartID) |
|
|
|
Dim CurLine as String |
|
Dim OutputLine as String |
|
Dim LengthOfCell as Integer |
|
Dim Sheet as Object |
|
Dim Cell as Object |
|
Dim CellContent(LAST_COLUMN) |
|
Dim IgnoreCell as Boolean |
|
Dim x As Integer |
|
Dim y As Integer |
|
Dim z As Integer |
|
|
|
Dim curID as Long |
|
|
|
Dim IgnoreLine as Boolean |
|
Dim lineloop As Integer |
|
|
|
Sheet = Doc.Sheets(SheetNum) |
|
|
|
curID = StartID |
|
|
|
'Loop over all rows in the current sheet |
|
For y = (FIRST_ROW - 1) to (LAST_ROW - 1) |
|
|
|
'Check if the current line is excluded from output as |
|
'it starts a new category. If it does, calculate the |
|
'the ID the new category starts with. |
|
IgnoreLine = False |
|
For lineloop = 0 to UBound(NEW_CATEGORY_LINES()) |
|
if (NEW_CATEGORY_LINES(lineloop) = (y+1)) then |
|
IgnoreLine = True |
|
'Calculate the new starting ID, i.e. the start of a new category |
|
'TTD: document this properly |
|
curId = StartID + (CATEGORY_RANGE * (lineloop + 1)) |
|
end if |
|
Next lineloop |
|
|
|
'Only process the line if it wasn't execluded above |
|
if (IgnoreLine = False) then |
|
|
|
'In JSON each line starts with an number that represents the line |
|
OutputLine = """" + y + """: {" + chr(13) |
|
|
|
'Give each record an unique ID, increment by 100! |
|
curID = curID + 100 |
|
OutputLine = OutputLine + """0"": """ + curID + """," + chr(13) |
|
|
|
'--------------------------------------------------- |
|
' 1st loop over all cells in the current comment |
|
' and put into a temporary array so we can modify it |
|
' during output |
|
'--------------------------------------------------- |
|
For x = 0 to (LAST_COLUMN - 1) |
|
' Get and convert text of the current cell |
|
|
|
Cell = Sheet.getCellByPosition(x,y) |
|
CellContent(x) = ConvertToHTMLandJson(Cell) |
|
|
|
Next ' cell |
|
|
|
'--------------------------------------------------- |
|
'2nd loop for modification and output of each cell |
|
'--------------------------------------------------- |
|
For x = 0 to (LAST_COLUMN - 1) |
|
|
|
' Convert text in current cell of the array to HTML |
|
CurLine = CellContent(x) |
|
|
|
' Check if current cell is excluded from output |
|
IgnoreCell = False |
|
For z = 0 to UBound(IGNORE_COLUMNS()) |
|
if (IGNORE_COLUMNS(z) = (x+1)) then IgnoreCell = True |
|
Next |
|
|
|
if IgnoreCell = false then |
|
|
|
' Put the current field into the SQL Text line with field delimiters |
|
OutputLine = OutputLine + """" + (x+1) + """: """ + CurLine + """" |
|
|
|
if x <> (LAST_COLUMN - 1) then OutputLine = OutputLine + ", " + chr(13) |
|
end if |
|
|
|
Next ' cell in current row |
|
|
|
' Terminate the row in the JSON output with a curly brace |
|
OutputLine = OutputLine + chr(13) + "}" |
|
|
|
' If there are additional rows, add a comma in the JSON output |
|
if y <> (LAST_ROW - 1) then |
|
OutputLine = OutputLine + "," + CHR$(13) |
|
end if |
|
|
|
Print #FileNo, OutputLine |
|
|
|
endif 'ignore line |
|
|
|
Next ' row |
|
|
|
End Function |
|
|
|
|
|
'**************************************************************** |
|
'** Convert the text in a Calc cell into HTML accounting |
|
'** for the formatting and characters that have to be HTML |
|
'** encoded. As this goes into a JSON formated structure, |
|
'** quote and backslash characters need to be escaped. |
|
'**************************************************************** |
|
|
|
Function ConvertToHTMLandJson (Cell) |
|
|
|
Dim CurLine As String |
|
Dim Enum1 As Object, Enum2 As Object |
|
Dim TextElement As Object, TextPortion As Object |
|
Dim TempString |
|
|
|
Enum1 = Cell.Text.createEnumeration |
|
|
|
' loop over all paragraphs |
|
While Enum1.hasMoreElements |
|
TextElement = Enum1.nextElement |
|
|
|
If TextElement.supportsService("com.sun.star.text.Paragraph") Then |
|
Enum2 = TextElement.createEnumeration |
|
CurLine = CurLine & "<p>" |
|
|
|
' Loop over all paragraph portions |
|
While Enum2.hasMoreElements |
|
TextPortion = Enum2.nextElement |
|
|
|
' Backslash needs to be escaped for JSON |
|
TempString = Replace(TextPortion.String, "\", "\\") |
|
|
|
' Fields are delimited by a " character. Escape this with |
|
' 2 double quotes for JSON |
|
TempString = Replace(TempString, """", "\""") |
|
|
|
' Convert Libreoffice text formats into HTML formatting |
|
If TextPortion.CharPosture = com.sun.star.awt.FontSlant.ITALIC THEN |
|
TempString = "<em>" & TempString & "</em>" |
|
End If |
|
|
|
if TextPortion.CharWeight = com.sun.star.awt.FontWeight.BOLD THEN |
|
TempString = "<b>" & TempString & "</b>" |
|
End If |
|
|
|
' Include text color if it is not default (black) |
|
If TextPortion.CharColor > 0 then |
|
TempString = "<span style=\""color:#" & Hex(TextPortion.CharColor) _ |
|
& "\"">" & TempString & "</span>" |
|
End If |
|
|
|
CurLine = Curline & TempString |
|
Wend |
|
|
|
CurLine = CurLine & "</p>" |
|
End If |
|
|
|
Wend |
|
|
|
ConvertToHTMLandJson = CurLine |
|
|
|
End Function |
|
|
|
|
|
|