The database to use when control over Excel documents is lost
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

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