romfast/roacont
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
09580ad9d679841d736157880d7b6a41f57f0883
roacont/Alte/SmartBill2ROA/vfpxworkbookxlsx.vc2

10018 lines
381 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="vfpxworkbookxlsx.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS vfpxworkbookxlsx AS label
*< CLASSDATA: Baseclass="label" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "vfpxworkbookxlsx.h"
*<DefinedPropArrayMethod>
*m: addclassdefinednumericformats && Adds pre-defined numeric cell formats
*m: addcustomnumericformat && Adds a new custom defined numeric format
*m: addindexcolor && Adds a new indexed color definition
*m: addinlinefontobject && Adds an object for setting the inline formatting of cell text
*m: addmrucolor && Adds a custom defined MRU color to the workbook
*m: addnamedrange && Adds a name range to the workbook
*m: addnumericformat && Adds a numeric format expression to be used
*m: addsheet && Adds a new sheet to the workbook
*m: addstringvalue && Adds a string value to the internal cursor
*m: addstyleborders && Adds to the cell style a border definition
*m: addstylefill && Adds to the cell style a fill definition
*m: addstylefont && Adds to the cell style a font definition
*m: addstylehorizalignment && Adds to the cell style horizontal cell alignment
*m: addstyleindent && Adds to the style indent definition
*m: addstylenumericformat && Adds to the style definition numeric format
*m: addstyletextrotation && Adds to the style definition text rotation
*m: addstylevertalignment && Adds to the cell style vertical cell alignment
*m: addstylewordwrap && Adds to the style definition word wrap
*m: cellformatpainter && Copies the formatting of a source cell to other cells
*m: cellrefasciitoindex && Converts a 'AA444' cell reference to the row and column index values
*m: clearcellvalidation && Clears/deletes the named range from the workbook
*m: clearcellvalue && Clears the cell value
*m: columnasciitoindex && Converts Excel Ascii column value to index value
*m: columnindextoascii && Gets the column ASCII code for the column index
*m: convertcolortohex && Converts a color value (integer) to Hex representation
*m: converthexstringtonumeric && ConvertHexStringToNumeric
*m: convertpixelstoexcelunits && Converts Pixel measurement to Excel measurement
*m: createexcelfile && Creates the Excel file from the components
*m: createformatstyle && Creates a new format style definition
*m: createinlineformattext && Creates an in-line text formatted definition
*m: createworkbook && Creates a new workbook object
*m: createworkbookex && Internal method for creating a workbook
*m: createworkingcursors && Creates the working cursors for worksheet definitions
*m: createworkingdirectories && Creates the working directories for the XML files
*m: debugcursorstofile && Debugging use for saving the internal cursors to a text file
*m: debugoutput && Limited functions for debugging
*m: debug_assign
*m: declaredll && Declares the required support Win32 API
*m: deleteallworkbooks && Deletes all workbooks
*m: deletesheet && Deletes the sheet from the Workbook
*m: deleteworkbook && Deletes the selected workbook
*m: demo && Demo for the features of this class
*m: derivesheetname && Derives the sheet name
*m: destroyworkingcursors && Destroys the working cursors
*m: documentation && Documentation of the methods and properties for this class
*m: freezepanes && Freezes the panes of the sheet
*m: getalphanumericsplit && Returns the position of the alpha and numeric split
*m: getbordersrecord && Gets the border record; returns True if found, or False in not found
*m: getcellalignment && Returns the cell alignment
*m: getcellborders && Returns the cell border info
*m: getcelldatatype && Returns the data type for the selected cell
*m: getcellfill && Returns the fill info for the cell
*m: getcellfont && Returns the cell font settings
*m: getcellformula && Returns the cell formula expression
*m: getcellformulafromxml && Gets the cell formula from the XML node
*m: getcellindent && Returns the cell indentation
*m: getcellnumberformat && Returns the format code for the selected cell
*m: getcellnumberformattext && Returns the selected cell numeric format as text
*m: getcellrecord && Positions to the xl_cells record; returns true if found, or false if not found
*m: getcellstyle && Gets the cell style value
*m: getcelltextrotation && Gets the cell text rotation value
*m: getcellvalidation && Returns the cell validation settings
*m: getcellvalue && Returns the value of the cell
*m: getcellwordwrap && Returns the cell word wrap setting
*m: getcellxfsid && Returns the Cell XfsId value
*m: getcellxfsrecord && Positions the record pointer to xl_cellxfs record; returns true if found, or false if not found
*m: getchecksum && Returns the checksum the string
*m: getchildnodecount && Returns the number of child nodes
*m: getchildnodeelement && Returns the selected child node
*m: getcolumnincolrowpair && Returns the column (Ascii value) in a ColRow pair; i.e., returns A from A6 reference
*m: getcolumnwidth && Returns the column width
*m: getcolwidthkeyexpr && Gets the key expression for c_colwidths
*m: getcursorrecord && Gets the specified xl_cursor record; returns true if found, false if not found
*m: getcustomnumericformat && Returns the format code for the specified custom numeric format
*m: getcustompapersize && Gets the values for the custom paper size
*m: getformatkeyexpr && Gets the key expression for t_format
*m: getheaderfooterkeyexpr && Gets the key expression for the header footer table record
*m: getinlinefontdefinition && Returns the inline formatting definition of cell text for each character group
*m: getlastcolumninrow && Returns the last column index in the row
*m: getlastrownumber && Returns the last row number in the sheet
*m: getmaxcolumnnumber && Returns the max column number for a sheet
*m: getnextid && Gets the next sequential Id value
*m: getnodeattributevalue && Returns the attribute value
*m: getnodecount && Returns the number of nodes to be processed
*m: getnodeelement && Gets the string content for the node element
*m: getnodeelementvalue && Gets the value assigned to the node element
*m: getnumberofsheets && Returns the number of sheets for the given workbook
*m: getpapersize && Gets the paper size for the selected sheet
*m: getprintorientation && Gets the print orientation for the sheet output
*m: getrelationshipfilename && Gets the file name for the R:Id value in the relationships XML
*m: getrgbvalues && Gets the specified RGB color value
*m: getrowheightkeyexpr && Gets the key expression for the c_rowheights
*m: getrowincolrowpair && REturns the row (integer value) in a ColRow pair; i.e., return 6 from A6 reference
*m: getrowmaxcolumn && Returns the selected row maximum column
*m: getsharedstringid && Gets the Shared Strings Id value for the cell text
*m: getsheetname && Gets the sheet name
*m: getsheetrecord && Positions the record in xl_sheets; returns true if record found, or false if not found
*m: getsheetrowvalues && Returns the cell values for the given row
*m: getsheetscale && Gets the sheet printing scale
*m: getstringrecord && Positions the record pointer to the selected string record
*m: getstringxml && Returns a converted string from XML to text
*m: getvalidation && Returns the validation definition
*m: getvalidationlist && Returns a list of validations for the workbook/sheet
*m: getworkbook && Gets the workbook Id from the name
*m: getworkbookfilename && Gets the file name for the workbook index
*m: getworkbooksheets && Returns the workbook sheets
*m: getxmlheaderfootertext && Returns a XML formatted string for the header and footer text
*m: getxmlstring && Gets the string as an XML formatted string
*m: initalizeidvalues && Initializes the internal Id values
*m: insertcell && Inserts a new cell into the sheet
*m: insertcolumn && Inserts a new column into the sheet
*m: insertrow && Inserts a new row into the sheet
*m: iscellformula && Returns True if cell contains a formula
*m: iscellreferenceinvalid && Checks if the cell reference is invalid (outside of limits)
*m: isformatstyledefined && Determines if the format is defined as a style
*m: isvalidborderstyle && Validates the border style value
*m: mergecells && Merges cells together
*m: ondestroy && Called by the Destroy() event - user implementation
*m: oninit && User code for Init() Event
*m: onshowerrormessage && Event for displaying an error message to the user
*m: onshowstatusmessage && Event for displaying a wait message to the user
*m: opencreatedxlsxfile && Opens the XLSX file via Win32 API default program
*m: openxlsxworkbook && Opens the passed Xlsx workbook and loads the internal cursors with the content
*m: parsestring && Parses a string based on a specified delimiter
*m: readcellvalueformat && Reads the cell value and format for a sheet
*m: readexternalrefxml && Reads the External References file
*m: readsharedstringsxml && Reads the sharedstrings.xml for opening workbooks
*m: readsheetxml && Reads the sheet.xml for opening a workbook
*m: readstylesxml && Reads the styles.xml file for opening a workbook
*m: removeworkingdirectories && Removes the working directories
*m: renamesheet && Renames the selected sheet
*m: resetcolumnwidth && Resets the column width to default
*m: saveasutf8 && Saves the file as a UTF-8
*m: savegridtoworkbook && Saves the selected grid to a workbook
*m: savegridtoworkbookex && Saves the passed grid to a workbook without adding the content to the internal cursors
*m: savemultigridtoworkbookex && Same as SaveGridToWorkbookEx() method but handles multiple grids being passed
*m: savetabletoworkbook && Saves the table passed (alias) as a workbook sheet
*m: savetabletoworkbookex && Creates a new workbook from a table; direct write to XLSX file without loading internal cursors
*m: saveworkbook && Saves the selected workbook as an XLSX file
*m: saveworkbookas && Saves the selected workbook with the new name
*m: setcellalignment && Sets the cell horizontal and vertical alignments
*m: setcellalignmentrange && Sets the cell alignment for a range of cells
*m: setcellborder
*m: setcellborderex
*m: setcellborderrange && Sets the cell border for a range of cells
*m: setcellfill && Sets the fill color for the cell
*m: setcellfillrange && Sets the fill for a range of cells
*m: setcellfont && Sets the selected cell font format
*m: setcellfontrange && Sets the cell font format for a range of cells
*m: setcellformula && Sets the cell formula expression
*m: setcellindent && Sets the cell indentation value
*m: setcellinlineformattext && Saves the in-line format definition to a cell value
*m: setcellnumberdecimals && Sets the number of decimals to display
*m: setcellnumberformat && Sets the cell number format
*m: setcellnumberformatrange && Sets the number format for a range of cells
*m: setcellstyle && Sets the cell style
*m: setcellstylerange && Sets the cell style for a range of cells
*m: setcelltextrotation && Sets the cell text rotation value
*m: setcellvalidation && Adds a cell validation
*m: setcellvalue && Sets the cell value
*m: setcellwordwrap && Sets the cell word-wrapping value
*m: setcellwordwraprange && Sets the word wrap for a range of cells
*m: setcolumnbestfit && Set the column to best fit
*m: setcolumnwidth && Sets the column width
*m: setcolumnwidthrange && Sets the column width for a range of columns
*m: setcustompapersize && Sets the paper size based on custom dimensions
*m: setdefaultborder && Sets the default border style for the workbook
*m: setdefaultfill && Sets the default fill for the workbook
*m: setdefaultfont && Sets the default font for the workbook
*m: setheaderfootersetup && Sets the header and footer setup for the sheet
*m: setheaderfootertext && Sets the header/footer text for the sheet
*m: setlastid && Sets the last used Id Value for strings, borders, fills, fonts, and cellxfs
*m: setpapersize && Sets the paper size for the selected sheet
*m: setprintfittoheight && Number of vertical pages to fit on for printing
*m: setprintfittowidth && Number of horizontal pages to fit on for printing
*m: setprintorientation && Sets the printer orientation for sheet output
*m: setrowheight && Sets the row height
*m: setrowheightrange && Sets the row height for a range of rows
*m: setrowmaxcolumn && Sets the value for the maximum cell column in a row
*m: setsheetmargins && Sets the sheet margin values
*m: setsheetscale && Sets the print scale; must be between 10 and 400; i.e. 10=10%, 100=100%, etc.
*m: setsheetvisibility && Sets the sheet visibility
*m: ttoc3 && Equlivalent of TTOC() function for pre VFP9 support
*m: unfreezepanes && Removes the pane freeze from the sheet
*m: unmergedcells && Unmerges merged cells
*m: writeasinlineformattedstring && Writes the string as formatted in-line
*m: writeasinlinestring && Writes the value as an inlineStr value
*m: writedirectcellformattedvalue && WriteDirectCellFormattedValue
*m: writedirectcellvalue && Writes the cell value directly to the sheets xml
*m: writedirectxmls && Writes the workbook XMLs for direct table/grid to workbook output
*m: writerelationshipsxml && Writes the relationships xml file
*m: writesheetxmls && Writes the Sheet XML files
*m: writestringsxml && Writes the sharedStrings XML
*m: writestylesxml && Writes the styles.xml support file
*m: writesupportxmls && Writes the [Content_Types].xml, .rels, core.xml, workbook.xml.rels and app.xml files
*m: writeworkbookxml && Writes the workbook XML
*p: autotrimsheetname && Indicates to auto-trim sheet name to max length ***Boolean
*p: codepage && CodePage to use for the Strings cursor
*p: companyname && Company Name
*p: creatorname && Creator Name
*p: debug && Sets debugging mode ***Boolean
*p: declarewinapi && Flag to execute the DeclareDLL method in the Init() ***Boolean
*p: defaultfont && Workbook Default Font
*p: defaultfontsize && Default font size ***Integer
*p: defaultsheetname && Default sheet name (language specific)
*p: errorlevelid && Error level Id ***Integer
*p: excelxlsxrelease && Release version of Class ***Integer
*p: oxdom && XML DOM Object
*p: savecurrencyasnumeric && Flag to save a currency value as a numeric rather than currency in the spreadsheet; will convert the value to four decimal places ***Boolean
*p: subject && Subject of Workbook (stored in properties)
*p: title && Title of workbook (stored in properties)
*p: truefalsevalue && The boolean value as displayed in Excel delimited by a pipe symbol
*p: username && User Name
*a: lastborderid[1,2] && Stores the last used border Id for a workbook
*a: lastcellxfsid[1,2] && Stores the last used CellXfs Id for a workbook
*a: lastfillid[1,2] && Stores the last used fill Id for a workbook
*a: lastfontid[1,2] && Stores the last used font Id for a workbook
*a: lastindexcolorid[1,2] && Last used IndexedColor Id
*a: lastmrucolorid[1,2] && Last used mruColor Id value
*a: lastnumfmtid[1,2] && Last used NumFmt Id
*a: lastrelationid[1,2] && Last used Relationship Id
*a: lastsheetid[1,2] && Last used sheet Id
*a: laststringid[1,2] && Stores the last used string Id for a workbook
*a: stringndx[1,0] && Returns the next string index value by workbook ***Integer
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Destroy,Init
*<PropValue>
AutoSize = .T.
autotrimsheetname = .T.
Caption = "clsVFPxWorkbookXLSX"
codepage = 0
companyname = VFPxWorkbookXLSX
creatorname = VFPxWorkbookXLSX
debug = .F.
declarewinapi = .T.
defaultfont = Calibri
defaultfontsize = 11
defaultsheetname = Sheet
errorlevelid = 0
excelxlsxrelease = 31
Height = 17
Name = "vfpxworkbookxlsx"
oxdom =
savecurrencyasnumeric = .F.
subject =
title =
truefalsevalue = Yes|No
username = VFPxWorkbookXLSX
Visible = .F.
Width = 129
_memberdata = <VFPData>
<memberdata name="autotrimsheetname" type="property" display="AutoTrimSheetName"/>
<memberdata name="defaultfontsize" type="property" display="DefaultFontSize"/>
<memberdata name="cellrefasciitoindex" type="method" display="CellRefAsciiToIndex"/>
<memberdata name="getchecksum" type="method" display="GetCheckSum"/>
<memberdata name="getstringrecord" type="method" display="GetStringRecord"/>
<memberdata name="initalizeidvalues" type="method" display="InitalizeIdValues"/>
<memberdata name="insertcell" type="method" display="InsertCell"/>
<memberdata name="insertcolumn" type="method" display="InsertColumn"/>
<memberdata name="insertrow" type="method" display="InsertRow"/>
<memberdata name="isformatstyledefined" type="method" display="IsFormatStyleDefined"/>
<memberdata name="saveasutf8" type="method" display="SaveAsUTF8"/>
<memberdata name="savegridtoworkbookex" type="method" display="SaveGridToWorkbookEx"/>
<memberdata name="savemultigridtoworkbookex" type="method" display="SaveMultiGridToWorkbookEx"/>
<memberdata name="savetabletoworkbookex" type="method" display="SaveTableToWorkbookEx"/>
<memberdata name="writeasinlineformattedstring" type="method" display="WriteAsInLineFormattedString"/>
<memberdata name="writeasinlinestring" type="method" display="WriteAsInLineString"/>
<memberdata name="writedirectcellformattedvalue" type="method" display="WriteDirectCellFormattedValue"/>
<memberdata name="writedirectcellvalue" type="method" display="WriteDirectCellValue"/>
<memberdata name="writedirectxmls" type="method" display="WriteDirectXMLs"/>
</VFPData>
*</PropValue>
PROTECTED PROCEDURE addclassdefinednumericformats && Adds pre-defined numeric cell formats
LPARAMETERS tnWB, tnFormatId
LOCAL llAdded, lcTextFormat, lcXMLFormat
DO CASE
CASE tnFormatId = CELL_FORMAT_CURRENCY_RED
lcTextFormat = '"$"#,##0.00;[Red]("$"#,##0.00)'
lcXMLFormat = this.GetXMLString(lcTextFormat)
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, CELL_FORMAT_CURRENCY_RED, lcXMLFormat, lcTextFormat, False)
llAdded = True
CASE tnFormatId = CELL_FORMAT_ACC_CURR_POUNDS
lcXMLFormat = '_-[$&#163;-809]* #,##0.00_-;-[$&#163;-809]* #,##0.00_-;_-[$&#163;-809]* &quot;-&quot;??_-;_-@_-'
lcTextFormat = '"<22>"#,##0.00;[Red]("<22>"#,##0.00)'
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, CELL_FORMAT_ACC_CURR_POUNDS, lcXMLFormat, lcTextFormat, False)
llAdded = True
CASE tnFormatId = CELL_FORMAT_ACC_CURR_EURO
lcXMLFormat = '_-[$&#8364;-2]* .00_-;-[$&#8364;-2]* .00_-;_-[$&#8364;-2]* &quot;-&quot;??_-;_-@_-'
lcTextFormat = '"<22>"#,##0.00;[Red]("<22>"#,##0.00)'
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, CELL_FORMAT_ACC_CURR_EURO, lcXMLFormat, lcTextFormat, False)
llAdded = True
CASE tnFormatId = CELL_FORMAT_CURR_POUNDS_RED
lcXMLFormat = '[$&#163;-809]#,##0.00;[Red]\-[$&#163;-809]#,##0.00'
lcTextFormat = '"<22>"#,##0.00;[Red]("<22>"#,##0.00)'
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, CELL_FORMAT_CURR_POUNDS_RED, lcXMLFormat, lcTextFormat, False)
llAdded = True
CASE tnFormatId = CELL_FORMAT_CURR_EURO_RED
lcXMLFormat = '[$&#8364;-2]\ #,##0.00_);[Red]\([$&#8364;-2]\ #,##0.00\)'
lcTextFormat = '"<22>"#,##0.00;[Red]("<22>"#,##0.00)'
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, CELL_FORMAT_CURR_EURO_RED, lcXMLFormat, lcTextFormat, False)
llAdded = True
OTHERWISE
llAdded = False
ENDCASE
RETURN llAdded
ENDPROC
PROCEDURE addcustomnumericformat && Adds a new custom defined numeric format
LPARAMETERS tnWB, tcPosFormat, tcNegFormat, tcZeroFormat, tcTextFormat, tlApplyDec
LOCAL lnId, lcFormatCode, lnNdx, lcSetPoint, lcSeparator
IF VARTYPE(tcPosFormat) != "C"
RETURN 0
ENDIF
DO CASE
CASE PCOUNT() = 1
tcNegFormat = ""
tcZeroFormat = ""
tcTextFormat = ""
tlApplyDec = False
CASE PCOUNT() = 2
tcZeroFormat = ""
tcTextFormat = ""
tlApplyDec = False
CASE PCOUNT() = 3
tcTextFormat = ""
tlApplyDec = False
CASE PCOUNT() = 4
tlApplyDec = False
ENDCASE
IF VARTYPE(tcNegFormat) != "C"
tcNegFormat = ""
ENDIF
IF VARTYPE(tcZeroFormat) != "C"
tcZeroFormat = ""
ENDIF
IF VARTYPE(tcTextFormat) != "C"
tcTextFormat = ""
ENDIF
IF OCCURS(";", tcPosFormat) > 0
RETURN 0
ENDIF
IF OCCURS(";", tcNegFormat) > 0
RETURN 0
ENDIF
IF OCCURS(";", tcZeroFormat) > 0
RETURN 0
ENDIF
IF OCCURS(";", tcTextFormat) > 0
RETURN 0
ENDIF
*-* If not US standard for separator and decimal point, then change to US standard
lcSetPoint = SET("POINT")
lcSeparator = SET("SEPARATOR")
IF lcSetPoint != "." .OR. lcSeparator != ","
tcPosFormat = CHRTRAN(tcPosFormat, lcSetPoint, TAB)
tcPosFormat = CHRTRAN(tcPosFormat, lcSeparator, CR)
tcPosFormat = CHRTRAN(tcPosFormat, TAB, ".")
tcPosFormat = CHRTRAN(tcPosFormat, CR, ",")
tcNegFormat = CHRTRAN(tcNegFormat, lcSetPoint, TAB)
tcNegFormat = CHRTRAN(tcNegFormat, lcSeparator, CR)
tcNegFormat = CHRTRAN(tcNegFormat, TAB, ".")
tcNegFormat = CHRTRAN(tcNegFormat, CR, ",")
tcZeroFormat = CHRTRAN(tcZeroFormat, lcSetPoint, TAB)
tcZeroFormat = CHRTRAN(tcZeroFormat, lcSeparator, CR)
tcZeroFormat = CHRTRAN(tcZeroFormat, TAB, ".")
tcZeroFormat = CHRTRAN(tcZeroFormat, CR, ",")
tcTextFormat = CHRTRAN(tcTextFormat, lcSetPoint, TAB)
tcTextFormat = CHRTRAN(tcTextFormat, lcSeparator, CR)
tcTextFormat = CHRTRAN(tcTextFormat, TAB, ".")
tcTextFormat = CHRTRAN(tcTextFormat, CR, ",")
ENDIF
*-* Build expression from parts
lcFormatCode = tcPosFormat
IF !EMPTY(tcNegFormat)
lcFormatCode = lcFormatCode + ";" + tcNegFormat
ENDIF
IF !EMPTY(tcZeroFormat)
lcFormatCode = lcFormatCode + ";" + tcZeroFormat
ENDIF
IF !EMPTY(tcTextFormat)
lcFormatCode = lcFormatCode + ";" + tcTextFormat
ENDIF
lnId = this.GetNextId(tnWB, "xl_numfmts")
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, lnId, this.GetXMLString(lcFormatCode), lcFormatCode, tlApplyDec)
RETURN lnId
ENDPROC
PROCEDURE addindexcolor && Adds a new indexed color definition
LPARAMETERS tnWB, tnRGBColor
LOCAL lnIndexId, lcHexColor
IF PCOUNT() != 2 .OR. VARTYPE(tnRGBColor) != "N"
RETURN 0
ENDIF
lcHexColor = this.ConvertColorToHex(tnRGBColor)
IF SEEK(BINTOC(tnWB)+lcHexColor, "xl_ndxcolors", "rgbcolor")
lnIndexId = xl_ndxcolors.indexid
ELSE
lnIndexId = this.GetNextId(tnWB, "xl_ndxcolors")
INSERT INTO xl_ndxcolors (workbook, indexid, rgbcolor) VALUES (tnWB, lnIndexId, lcHexColor)
ENDIF
RETURN lnIndexId
ENDPROC
PROCEDURE addinlinefontobject && Adds an object for setting the inline formatting of cell text
LPARAMETERS toInline, tnBeg, tnLen, tcFontName, tnFontSize, tnFontColor, tlFontBold, tlFontItalic, tcULine, tlStrkThru, tlSubscript, tlSuperscript
LOCAL loCharacter
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF VARTYPE(toInline) != "O"
RETURN .NULL.
ENDIF
DO CASE
CASE PCOUNT() = 4
tnFontSize = 10
tnFontColor = RGB(0,0,0)
tlFontBold = False
tlFontItalic = False
tcULine = UNDERLINE_NONE
tlStrkThru = False
tlSubscript = False
tlSuperscript = False
CASE PCOUNT() = 5
tnFontColor = RGB(0,0,0)
tlFontBold = False
tlFontItalic = False
tcULine = UNDERLINE_NONE
tlStrkThru = False
tlSubscript = False
tlSuperscript = False
CASE PCOUNT() = 6
tlFontBold = False
tlFontItalic = False
tcULine = UNDERLINE_NONE
tlStrkThru = False
tlSubscript = False
tlSuperscript = False
CASE PCOUNT() = 7
tlFontItalic = False
tcULine = UNDERLINE_NONE
tlStrkThru = False
tlSubscript = False
tlSuperscript = False
CASE PCOUNT() = 8
tcULine = UNDERLINE_NONE
tlStrkThru = False
tlSubscript = False
tlSuperscript = False
CASE PCOUNT() = 9
tlStrkThru = False
tlSubscript = False
tlSuperscript = False
CASE PCOUNT() = 10
tlSubscript = False
tlSuperscript = False
CASE PCOUNT() = 11
tlSuperscript = False
ENDCASE
loCharacter = CREATEOBJECT("Empty")
ADDPROPERTY(loCharacter, "BegPos", tnBeg)
ADDPROPERTY(loCharacter, "Length", tnLen)
ADDPROPERTY(loCharacter, "FontName", tcFontName)
ADDPROPERTY(loCharacter, "FontSize", tnFontSize)
ADDPROPERTY(loCharacter, "FontBold", tlFontBold)
ADDPROPERTY(loCharacter, "FontItalic", tlFontItalic)
ADDPROPERTY(loCharacter, "FontColor", tnFontColor)
ADDPROPERTY(loCharacter, "Underline", tcULine)
ADDPROPERTY(loCharacter, "StrikeThru", tlStrkThru)
ADDPROPERTY(loCharacter, "SubScript", tlSubscript)
ADDPROPERTY(loCharacter, "SuperScript", tlSuperscript)
toInline.Count = toInline.Count + 1
DIMENSION toInline.Characters[toInline.Count]
toInline.Characters[toInline.Count] = loCharacter
RETURN toInline
ENDPROC
PROCEDURE addmrucolor && Adds a custom defined MRU color to the workbook
LPARAMETERS tnWB, tnRGBColor
LOCAL lnIndexId, lcHexColor
IF PCOUNT() != 2 .OR. VARTYPE(tnRGBColor) != "N"
RETURN 0
ENDIF
lcHexColor = this.ConvertColorToHex(tnRGBColor)
IF SEEK(BINTOC(tnWB)+lcHexColor, "xl_mrucolors", "rgbcolor")
lnIndexId = xl_mrucolors.indexid
ELSE
lnIndexId = this.GetNextId(tnWB, "xl_mrucolors")
INSERT INTO xl_mrucolors (workbook, indexid, rgbcolor) VALUES (tnWB, lnIndexId, lcHexColor)
ENDIF
RETURN lnIndexId
ENDPROC
PROCEDURE addnamedrange && Adds a name range to the workbook
LPARAMETERS tnWB, tnSheet, tcName, tnScope, tcComment, tnBegRow, tnBegCol, tnEndRow, tnEndCol
LOCAL lcRangeName
IF PCOUNT() < 8
RETURN ""
ENDIF
IF VARTYPE(tcName) != "C" .OR. LEN(tcName) > 50
RETURN ""
ENDIF
IF VARTYPE(tnScope) != "N"
tnScope = 0
ENDIF
IF VARTYPE(tcComment) != "C"
tcComment = ""
ENDIF
IF LEN(tcComment) > 254
RETURN ""
ENDIF
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN ""
ENDIF
lcRangeName = CHRTRAN(ALLTRIM(tcName), " !@#$%^&*()+={}[]|<>,.'?/" + CHR(34), REPLICATE("_", 25))
IF !ISALPHA(lcRangeName) .AND. !INLIST(LEFT(lcRangeName, 1), "_", "\")
lcRangeName = "_" + lcRangeName
ENDIF
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook") .AND. !SEEK(BINTOC(tnWB)+PADL(lcRangeName, 254, " "), "xl_namerange", "wbrname")
INSERT INTO xl_namerange (workbook, sheet, rname, scope, comment, begrow, begcol, endrow, endcol) ;
VALUES (tnWB, tnSheet, lcRangeName, tnScope, tcComment, tnBegRow, tnBegCol, tnEndRow, tnEndCol)
ELSE
lcRangeName = ""
ENDIF
RETURN lcRangeName
ENDPROC
PROCEDURE addnumericformat && Adds a numeric format expression to be used
LPARAMETERS tnWB, tcFormatCode
LOCAL lcPosCode, lcNegCode, lcZerCode
IF PCOUNT() < 2
RETURN 0
ENDIF
IF VARTYPE(tnWB) != "N" .AND. tnWB > 0
RETURN 0
ENDIF
IF VARTYPE(tcFormatCode) != "C"
RETURN 0
ENDIF
lcPosCode = this.ParseString(tcFormatCode, 1, ";")
lcNegCode = this.ParseString(tcFormatCode, 2, ";")
lcZerCode = this.ParseString(tcFormatCode, 3, ";")
RETURN this.AddCustomNumericFormat(tnWB, lcPosCode, lcNegCode, lcZerCode)
ENDPROC
PROCEDURE addsheet && Adds a new sheet to the workbook
LPARAMETERS tnWB, tcSheetName, tnState
LOCAL lnShId, lnRelId
lnShId = 0
IF PCOUNT() > 0 .AND. SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
lnShId = this.GetNextId(tnWB, "xl_sheets")
DO CASE
CASE PCOUNT() = 0
CASE PCOUNT() = 1
tcSheetName = "Sheet" + TRANSFORM(lnShId + 1) && Bug fix identified by Dan Lauer
tnState = VISIBLE_SHEET_STATE
CASE PCOUNT() = 2
IF VARTYPE(tcSheetName) != "C"
tcSheetName = "Sheet" + TRANSFORM(lnShId + 1)
ENDIF
tnState = VISIBLE_SHEET_STATE
OTHERWISE
IF VARTYPE(tcSheetName) != "C"
tcSheetName = "Sheet" + TRANSFORM(lnShId + 1)
ENDIF
IF VARTYPE(tnState) != "N"
tnState = VISIBLE_SHEET_STATE
ENDIF
ENDCASE
IF EMPTY(tcSheetName)
tcSheetName = "Sheet" + TRANSFORM(lnShId + 1)
ENDIF
tcSheetName = CHRTRAN(tcSheetName, ":\/?*", "_____")
IF LEN(tcSheetName) > LIMITS_MAX_SH_NAME
IF this.AutoTrimSheetName
tcSheetName = LEFT(ALLTRIM(tcSheetName), LIMITS_MAX_SH_NAME)
ELSE
this.SetLastId(tnWB, lnShId-1, "xl_sheets")
RETURN 0
ENDIF
ENDIF
IF SEEK(BINTOC(tnWB)+UPPER(PADR(tcSheetName, LEN(xl_sheets.shname))), "xl_sheets", "shname") && Change recommendation by Doug Hennig
lnShId = 0
ELSE
INSERT INTO xl_sheets (workbook, sheet, shname, state, mleft, mright, mtop, mbot, mheader, mfooter, shdeleted, xsplit, ysplit, prnorient, ;
papersize, paperwidth, paperheight, scale, fittowidth, fittoheight) ;
VALUES (tnWB, lnShId, tcSheetName, tnState, 0.75, 0.75, 0.75, 0.75, 0.3, 0.3, False, 0, 0, PORTRAIT_PRINT_ORIENTATION, 0, 0, 0, 100, 0, 0)
lnRelId = this.GetNextId(tnWB, "xl_relationships")
INSERT INTO xl_relationships (workbook, sheet, relid, reltype, target) VALUES (tnWB, lnShId, lnRelId, "worksheet", "worksheets/sheet" + TRANSFORM(lnShId) + ".xml")
ENDIF
ENDIF
RETURN lnShId
ENDPROC
PROTECTED PROCEDURE addstringvalue && Adds a string value to the internal cursor
LPARAMETERS tnWB, tcString, tlInLine
LOCAL lcStringXml, lnStringId, llPresrvSp, lcCheckSum
IF tlInLine
llPresrvSp = IIF(LEFT(tcString, 1) = " ", True, False)
lcStringXml = this.GetXMLString(tcString)
lnStringId = this.GetNextId(tnWB, "xl_strings")
lcCheckSum = this.GetCheckSum(tcString)
INSERT INTO xl_strings (id, workbook, checksum, stringxml, stringval, presvspace, formatted) ;
VALUES (lnStringId, tnWB, lcCheckSum, lcStringXml, tcString, llPresrvSp, True)
ELSE
IF this.GetStringRecord(tnWB, tcString) .AND. xl_strings.formatted = False
lnStringId = xl_strings.id
ELSE
llPresrvSp = IIF(LEFT(tcString, 1) = " " .OR. RIGHT(tcString, 1) = " ", True, False)
lcStringXml = this.GetXMLString(tcString)
lnStringId = this.GetNextId(tnWB, "xl_strings")
lcCheckSum = this.GetCheckSum(tcString)
INSERT INTO xl_strings (id, workbook, checksum, stringxml, stringval, presvspace, formatted) ;
VALUES (lnStringId, tnWB, lcCheckSum, lcStringXml, tcString, llPresrvSp, False)
ENDIF
ENDIF
RETURN lnStringId
ENDPROC
PROCEDURE addstyleborders && Adds to the cell style a border definition
LPARAMETERS tnWB, tnCellXfsId, tnBorders, tcStyle, tnColor
LOCAL lnDiagDn, lnDiagUp, lcLStyle, lnLColor, lcRStyle, lnRColor, lcTStyle, lnTColor, lcBStyle, lnBColor
LOCAL lcDStyle, lnDColor, lnBorderId
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tnBorders) != 'N' .OR. EMPTY(tnBorders) .OR. !BETWEEN(tnBorders, 0, 63)
tnBorders = 0
ENDIF
IF !this.IsValidBorderStyle(tcStyle)
tcStyle = BORDER_STYLE_NONE
ENDIF
IF VARTYPE(tnColor) != 'N' .OR. !BETWEEN(tnColor, 0, RGB(255,255,255)) .OR. EMPTY(tnColor)
tnColor = RGB(0, 0, 0)
ENDIF
STORE 0 TO lnDiagDn, lnDiagUp
STORE RGB(0,0,0) TO lnLColor, lnRColor, lnTColor, lnBColor, lnDColor
STORE BORDER_STYLE_NONE TO lcLStyle, lcRStyle, lcTStyle, lcBStyle, lcDStyle
IF BITTEST(tnBorders, 0)
lcLStyle = tcStyle
lnLColor = tnColor
ENDIF
IF BITTEST(tnBorders, 1)
lcRStyle = tcStyle
lnRColor = tnColor
ENDIF
IF BITTEST(tnBorders, 2)
lcTStyle = tcStyle
lnTColor = tnColor
ENDIF
IF BITTEST(tnBorders, 3)
lcBStyle = tcStyle
lnBColor = tnColor
ENDIF
IF BITTEST(tnBorders, 4)
lcDStyle = tcStyle
lnDColor = tnColor
lnDiagDn = 1
ENDIF
IF BITTEST(tnBorders, 5)
lcDStyle = tcStyle
lnDColor = tnColor
lnDiagUp = 1
ENDIF
IF this.GetBordersRecord(tnWB, lcLStyle, lnLColor, lcRStyle, lnRColor, lcTStyle, lnTColor, lcBStyle, lnBColor, lcDStyle, lnDColor, lnDiagDn, lnDiagUp)
lnBorderId = xl_borders.id
ELSE
lnBorderId = this.GetNextId(tnWB, 'xl_borders')
INSERT INTO xl_borders (workbook, id, lstyle, lcolor, rstyle, rcolor, tstyle, tcolor, bstyle, bcolor, dstyle, dcolor, diagdn, diagup) ;
VALUES (tnWB, lnBorderId, lcLStyle, lnLColor, lcRStyle, lnRColor, lcTStyle, lnTColor, lcBStyle, lnBColor, lcDStyle, lnDColor, lnDiagDn, lnDiagUp)
ENDIF
*-* Set the border id to the style definition
REPLACE xl_cellxfs.borderid WITH lnBorderId IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstylefill && Adds to the cell style a fill definition
LPARAMETERS tnWB, tnCellXfsId, tnFColor, tnBColor, tcPatternType
LOCAL lnFillId, lnFIndex, lnBIndex
DO CASE
CASE PCOUNT() < 3
RETURN False
CASE PCOUNT() = 3
tnBColor = tnFColor
tcPatternType = FILL_STYLE_SOLID
CASE PCOUNT() = 4
tcPatternType = FILL_STYLE_SOLID
ENDCASE
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tnFColor) = 'N' .AND. BETWEEN(tnFColor, 0, RGB(255, 255, 255))
tnFColor = FLOOR(tnFColor)
lnFIndex = 0
ELSE
tnFColor = 0
lnFIndex = 64
ENDIF
IF VARTYPE(tnBColor) = 'N' .AND. BETWEEN(tnBColor, 0, RGB(255, 255, 255))
tnBColor = FLOOR(tnBColor)
lnBIndex = 0
ELSE
tnBColor = tnFColor
lnBIndex = lnFIndex
ENDIF
IF VARTYPE(tcPatternType) != "C" .OR. EMPTY(tcPatternType)
tcPatternType = FILL_STYLE_SOLID
ENDIF
*-* Get the fill record id
IF SEEK(BINTOC(tnWB)+BINTOC(tnFColor)+BINTOC(tnBColor)+tcPatternType, "xl_fills", "fillcolor")
lnFillId = xl_fills.id
REPLACE xl_fills.theme WITH 0, ;
xl_fills.tint WITH 0, ;
xl_fills.fgindexed WITH lnFIndex, ;
xl_fills.bgindexed WITH lnBIndex IN xl_fills
ELSE
lnFillId = this.GetNextId(tnWB, 'xl_fills')
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed) ;
VALUES (tnWB, lnFillId, tnFColor, tnBColor, tcPatternType, 0, 0, lnFIndex, lnBIndex)
ENDIF
*-* Set the fill id to the style definition
REPLACE xl_cellxfs.fillid WITH lnFillId IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstylefont && Adds to the cell style a font definition
LPARAMETERS tnWB, tnCellXfsId, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos
LOCAL lnFontId
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tcFName) != 'C' .OR. EMPTY(tcFName)
tcFName = 'Calibri'
ENDIF
tcFName = PROPER(ALLTRIM(tcFName))
IF VARTYPE(tnFSize) != 'N' .OR. EMPTY(tnFSize) .OR. tnFSize < 0.5
tnFSize = 11
ELSE
tnFSize = INT(tnFSize)
ENDIF
IF VARTYPE(tlBold) != 'L'
tlBold = False
ENDIF
IF VARTYPE(tlItalic) != 'L'
tlItalic = False
ENDIF
IF VARTYPE(tnFColor) = 'N' .AND. BETWEEN(tnFColor, 0, RGB(255, 255, 255))
tnFColor = FLOOR(tnFColor)
ELSE
tnFColor = RGB(0, 0, 0)
ENDIF
IF VARTYPE(tlStrikThr) != 'L'
tlStrikThr = False
ENDIF
IF VARTYPE(tcULine) != 'C' .OR. !INLIST(tcULine, UNDERLINE_SINGLE, UNDERLINE_DOUBLE, UNDERLINE_SINGLEACCOUNTING, UNDERLINE_DOUBLEACCOUNTING, UNDERLINE_NONE)
tcULine = UNDERLINE_NONE
ENDIF
IF VARTYPE(tcVPos) != 'C' .OR. !INLIST(tcVPos, FONT_VERTICAL_BASELINE, FONT_VERTICAL_SUBSCRIPT, FONT_VERTICAL_SUPERSCRIPT)
tcVPos = FONT_VERTICAL_BASELINE
ENDIF
*-* Get the font record id
IF SEEK(BINTOC(tnWB)+PADR(tcFName, 100) + STR(tnFSize, 5, 1) + TRANSFORM(tlBold) + TRANSFORM(tlItalic) + PADL(tnFColor, 15) + PADR(tcULine, 16) + ;
TRANSFORM(tlStrikThr) + PADR(tcVPos, 11), "xl_fonts", "cellformat")
lnFontId = xl_fonts.id
REPLACE xl_fonts.theme WITH 0, ;
xl_fonts.tint WITH 0, ;
xl_fonts.indexed WITH 0 IN xl_fonts
ELSE
lnFontId = this.GetNextId(tnWB, 'xl_fonts')
INSERT INTO xl_fonts (workbook, id, fname, fsize, fbold, fitalic, fcolor, uline, strkthr, fvpos) ;
VALUES (tnWB, lnFontId, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos)
ENDIF
*-* Set the font id to the style definition
REPLACE xl_cellxfs.fontid WITH lnFontId IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstylehorizalignment && Adds to the cell style horizontal cell alignment
LPARAMETERS tnWB, tnCellXfsId, tcHorizAlign
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tcHorizAlign) = 'C' .AND. INLIST(tcHorizAlign, CELL_HORIZ_ALIGN_LEFT, CELL_HORIZ_ALIGN_RIGHT, CELL_HORIZ_ALIGN_CENTER)
REPLACE xl_cellxfs.halign WITH tcHorizAlign IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstyleindent && Adds to the style indent definition
LPARAMETERS tnWB, tnCellXfsId, tnIndent
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tnIndent) = 'N'
REPLACE xl_cellxfs.indent WITH tnIndent IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstylenumericformat && Adds to the style definition numeric format
LPARAMETERS tnWB, tnCellXfsId, tnNumFmtId
LOCAL lnNumFmtId
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
DO CASE
CASE VARTYPE(tnNumFmtId) != 'N'
RETURN False
CASE tnNumFmtId < START_NUMERIC_FORMAT_ID
lnNumFmtId = tnNumFmtId
CASE tnNumFmtId >= START_NUMERIC_FORMAT_ID
IF SEEK(BINTOC(tnWB)+BINTOC(tnNumFmtId), "xl_numfmts", "id")
lnNumFmtId = xl_numfmts.id
ELSE
IF !this.AddClassDefinedNumericFormats(tnWB, tnNumFmtId)
RETURN False
ENDIF
lnNumFmtId = tnNumFmtId
ENDIF
OTHERWISE
RETURN False
ENDCASE
REPLACE xl_cellxfs.numfmtid WITH lnNumFmtId IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstyletextrotation && Adds to the style definition text rotation
LPARAMETERS tnWB, tnCellXfsId, tnRotation
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tnRotation) = 'N' .AND. BETWEEN(tnRotation, -90, 90)
REPLACE xl_cellxfs.rotation WITH tnRotation IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstylevertalignment && Adds to the cell style vertical cell alignment
LPARAMETERS tnWB, tnCellXfsId, tcVertAlign
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tcVertAlign) = 'C' .AND. INLIST(tcVertAlign, CELL_VERT_ALIGN_TOP, CELL_VERT_ALIGN_BOTTOM, CELL_VERT_ALIGN_CENTER)
REPLACE xl_cellxfs.valign WITH tcVertAlign IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE addstylewordwrap && Adds to the style definition word wrap
LPARAMETERS tnWB, tnCellXfsId, tlWordWrap
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tlWordWrap) = 'L'
REPLACE xl_cellxfs.wraptext WITH IIF(tlWordWrap, 1, 0) IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE cellformatpainter && Copies the formatting of a source cell to other cells
LPARAMETERS tnWB, tnSheet, tnSrcRow, tnSrcCol, tnBegRow, tnBegCol, tnEndRow, tnEndCol
LOCAL lnCellXfs, lnNumDec, llReturn, lnRow, lnCol
DO CASE
CASE PCOUNT() < 6
RETURN False
CASE PCOUNT() = 6
tnEndRow = tnBegRow
tnEndCol = tnBegCol
CASE PCOUNT() = 7
tnEndCol = tnBegCol
ENDCASE
IF this.GetCellRecord(tnWB, tnSheet, tnSrcRow, tnSrcCol)
lnCellXfs = xl_cells.cellxfs
lnNumDec = xl_cells.numdec
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF this.GetCellRecord(tnWB, tnSheet, lnRow, lnCol)
REPLACE xl_cells.cellxfs WITH lnCellXfs, ;
xl_cells.numdec WITH lnNumDec IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, lnRow, lnCol, DATA_TYPE_NONE, lnCellXfs, False, lnNumDec, 0)
ENDIF
ENDFOR
ENDFOR
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE cellrefasciitoindex && Converts a 'AA444' cell reference to the row and column index values
LPARAMETERS tcCellRef
LOCAL lnCellCol, lnNdx, lnCellRow, loCellRef
lnCellCol = this.ColumnAsciiToIndex(tcCellRef)
lnCellRow = 0
FOR lnNdx=1 TO LEN(tcCellRef)
IF ISDIGIT(SUBSTR(tcCellRef, lnNdx))
lnCellRow = INT(VAL(SUBSTR(tcCellRef, lnNdx)))
EXIT
ENDIF
ENDFOR
loCellRef = CREATEOBJECT("Empty")
ADDPROPERTY(loCellRef, "Column", lnCellCol)
ADDPROPERTY(loCellRef, "Row", lnCellRow)
RETURN loCellRef
ENDPROC
PROCEDURE clearcellvalidation && Clears/deletes the named range from the workbook
LPARAMETERS tnWB, tcName
IF PCOUNT() < 2
RETURN False
ENDIF
IF VARTYPE(tcName) != "C"
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+PADL(tcName, 254, " "), "xl_namerange", "wbrname")
DELETE IN xl_namerange
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE clearcellvalue && Clears the cell value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL llReturn
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.celldeleted WITH True IN xl_cells
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE columnasciitoindex && Converts Excel Ascii column value to index value
LPARAMETERS tcColIndex
LOCAL lnIndex, lnNdx, lnChr
lnIndex = 0
FOR lnNdx=1 TO LEN(tcColIndex)
lnChr = ASC(UPPER(SUBSTR(tcColIndex, lnNdx, 1)))
IF BETWEEN(lnChr, 65, 90)
lnIndex = (lnChr - 64) + (lnIndex * 26)
ELSE
EXIT
ENDIF
ENDFOR
RETURN lnIndex
ENDPROC
PROCEDURE columnindextoascii && Gets the column ASCII code for the column index
LPARAMETERS tnCol
LOCAL lnRemCol, lcColumn, lnPartCol
IF PCOUNT() = 0 .OR. VARTYPE(tnCol) != "N"
RETURN ""
ENDIF
TRY
lnRemCol = tnCol
lcColumn = ""
DO WHILE lnRemCol > 0
lnPartCol = MOD(lnRemCol, 26)
IF lnPartCol = 0
lnPartCol = 26
ENDIF
lnRemCol = (lnRemCol - lnPartCol) / 26
lcColumn = CHR(lnPartCol + 64) + lcColumn
ENDDO
CATCH TO loException
SET STEP ON
ENDTRY
RETURN lcColumn
ENDPROC
PROTECTED PROCEDURE convertcolortohex && Converts a color value (integer) to Hex representation
LPARAMETERS tnColor
LOCAL lnRed, lnGreen, lnBlue, lcHexRed, lcHexGreen, lcHexBlue
lnRed = this.GetRGBValues(tnColor, 'R')
lnGreen = this.GetRGBValues(tnColor, 'G')
lnBlue = this.GetRGBValues(tnColor, 'B')
lcHexRed = RIGHT(TRANSFORM(lnRed, '@0'), 2)
lcHexGreen = RIGHT(TRANSFORM(lnGreen, '@0'), 2)
lcHexBlue = RIGHT(TRANSFORM(lnBlue, '@0'), 2)
RETURN "FF" + UPPER(lcHexRed + lcHexGreen + lcHexBlue)
ENDPROC
PROTECTED PROCEDURE converthexstringtonumeric && ConvertHexStringToNumeric
LPARAMETERS tcHexNum
LOCAL lcValue
IF EMPTY(tcHexNum)
RETURN 0
ENDIF
IF LEN(tcHexNum) > 6
tcHexNum = SUBSTR(tcHexNum, 3)
ENDIF
tcHexNum = UPPER(ALLTRIM(tcHexNum))
tcHexNum = RIGHT(tcHexNum, 2) + SUBSTR(tcHexNum, 3, 2) + LEFT(tcHexNum, 2)
lcValue = "0x" + tcHexNum
RETURN EVAL(lcValue)
ENDPROC
PROCEDURE convertpixelstoexcelunits && Converts Pixel measurement to Excel measurement
LPARAMETERS tnPixels
RETURN tnPixels * 0.152542
ENDPROC
PROTECTED PROCEDURE createexcelfile && Creates the Excel file from the components
LPARAMETERS tcTempPath, tcFilePath, tcWBName
LOCAL loShell, loFolder, lcZipFile, loException, loFile, lnCountBefore, lcFile, lcZipPath, lnCount, lhFile
lcZipPath = ALLTRIM(tcFilePath)
IF EMPTY(lcZipPath)
lcZipPath = SYS(5) + SYS(2003)
ENDIF
lcZipFile = ADDBS(lcZipPath) + FORCEEXT(ALLTRIM(tcWBName), "zip")
*-* Delete any prior file with same Excel name
IF FILE(FORCEEXT(lcZipFile, "xlsx"))
TRY
ERASE (FORCEEXT(lcZipFile, "xlsx"))
llError = False
CATCH TO loException
this.ErrorLevelId = 10
RAISEEVENT(this, "OnShowErrorMessage", 10, "Error - unable to delete existing file" + CR + loException.Message)
llError = True
ENDTRY
IF llError
RETURN False
ENDIF
ENDIF
*-* Validate that the file name and path are valid
TRY
lhFile = FCREATE(lcZipFile, 0)
FCLOSE(lhFile)
CATCH TO loException
this.ErrorLevelId = 11
RAISEEVENT(this, "OnShowErrorMessage", 11, "CreateExcelFile - Failed to create Zip file"+ CR + loException.Message)
RETURN False
ENDTRY
*-* Create base zip file
STRTOFILE(CHR(80)+CHR(75)+CHR(5)+CHR(6)+REPLICATE(CHR(0), 18), lcZipFile, 0)
loShell = CREATEOBJECT("shell.application")
loFolder = loShell.NameSpace(tcTempPath).Items
*-* Add the files to the zip
IF OS(3)<'6' .OR. OS(3)='6' .AND. OS(4)<'1'
TRY
FOR EACH loFile IN loFolder
loShell.NameSpace(lcZipFile).MoveHere(loFile, FOF_SILENT)
apiSleep(100)
ENDFOR
CATCH TO loException
SET STEP ON
ENDTRY
llErr = True
DO WHILE llErr
TRY
apiMoveFile(lcZipFile, FORCEEXT(lcZipFile, "xlsx"))
llErr = False
CATCH
apiSleep(100)
ENDTRY
ENDDO
ELSE
TRY
FOR EACH loFile IN loFolder
lnCountBefore = loShell.NameSpace(tcTempPath).Items.Count
loShell.NameSpace(lcZipFile).MoveHere(loFile, FOF_SILENT)
DO WHILE lnCountBefore = loShell.NameSpace(tcTempPath).Items.Count
apiSleep(50)
ENDDO
ENDFOR
CATCH TO loException
this.ErrorLevelId = 12
RAISEEVENT(this, "OnShowErrorMessage", 12, "CreateExcelFile - Failed to add contents to Zip file"+ CR + loException.Message)
SET STEP ON
ERASE (lcZipFile)
DO CASE
CASE loException.ErrorNo = 1943
OTHERWISE
SET STEP ON
ENDCASE
ENDTRY
TRY
apiMoveFile(lcZipFile, FORCEEXT(lcZipFile, "xlsx"))
CATCH TO loException
this.ErrorLevelId = 13
RAISEEVENT(this, "OnShowErrorMessage", 13, "CreateExcelFile - Rename failed"+ CR + loException.Message)
SET STEP ON
ENDTRY
ENDIF
RETURN True
ENDPROC
PROCEDURE createformatstyle && Creates a new format style definition
LPARAMETERS tnWB
IF PCOUNT() > 0 .AND. SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
lnId = this.GetNextId(tnWB, "xl_cellxfs")
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, rotation) ;
VALUES (tnWB, lnId, 0, 0, 0, 0, "", "", 0, 0, 0)
RETURN lnId
ELSE
RETURN -1
ENDIF
ENDPROC
PROCEDURE createinlineformattext && Creates an in-line text formatted definition
LPARAMETERS tnWB, tcCellText
LOCAL loInline
loInline = CREATEOBJECT("Empty")
ADDPROPERTY(loInline, "Workbook", tnWB)
ADDPROPERTY(loInline, "StringId", .NULL.)
ADDPROPERTY(loInline, "StringValue", tcCellText)
ADDPROPERTY(loInline, "Count", 0)
ADDPROPERTY(loInline, "Characters[1]")
loInline.Characters[1] = .NULL.
RETURN loInline
ENDPROC
PROCEDURE createworkbook && Creates a new workbook object
LPARAMETERS tcName
LOCAL lcWBName, lcPath, lnWB
IF PCOUNT() = 1
tlLoadDefaults = True
ENDIF
lcWBName = JUSTSTEM(tcName)
lcPath = JUSTPATH(tcName)
IF EMPTY(lcPath)
lcPath = SYS(5) + SYS(2003)
tcName = ADDBS(lcPath) + lcWBName + "." + JUSTEXT(tcName)
ENDIF
IF SEEK(PADR(UPPER(tcName), 240, "_"), "xl_workbooks", "fullname")
lnWB = 0
ELSE
INSERT INTO xl_workbooks (wbname, filepath, fullname) VALUES (lcWBName, lcPath, PADR(UPPER(tcName), 240, "_"))
lnWB = xl_workbooks.workbook
this.SetDefaultFont(lnWB, this.DefaultFont, this.DefaultFontSize) && Change recommended by Doug Hennig; 2017-06-12
this.SetDefaultBorder(lnWB, BORDER_STYLE_NONE)
INSERT INTO xl_relationships (workbook, relid, reltype, target) VALUES (lnWB, 1, "styles", "styles.xml")
INSERT INTO xl_relationships (workbook, relid, reltype, target) VALUES (lnWB, 2, "sharedStrings", "sharedStrings.xml")
this.SetLastId(lnWB, 2, "xl_relationships")
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext) ;
VALUES (lnWB, 0, 0, 0, 0, 0, "", "", 0, 0)
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed) ;
VALUES (lnWB, 0, 0, 0, FILL_STYLE_NONE, 0, 0, 0, 0)
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed) ;
VALUES (lnWB, 1, 0, 0, FILL_STYLE_GRAY125, 0, 0, 0, 0)
ENDIF
RETURN lnWB
ENDPROC
PROTECTED PROCEDURE createworkbookex && Internal method for creating a workbook
LPARAMETERS tcName
LOCAL lcWBName, lcPath, lnWB
lcWBName = JUSTSTEM(tcName)
lcPath = JUSTPATH(tcName)
IF EMPTY(lcPath)
lcPath = SYS(5) + SYS(2003)
tcName = ADDBS(lcPath) + lcWBName + "." + JUSTEXT(tcName)
ENDIF
IF SEEK(PADR(UPPER(tcName), 240, "_"), "xl_workbooks", "fullname")
lnWB = 0
ELSE
INSERT INTO xl_workbooks (wbname, filepath, fullname) VALUES (lcWBName, lcPath, PADR(UPPER(tcName), 240, "_"))
lnWB = xl_workbooks.workbook
ENDIF
RETURN lnWB
ENDPROC
PROTECTED PROCEDURE createworkingcursors && Creates the working cursors for worksheet definitions
IF USED('xl_strings')
RETURN
ENDIF
DO CASE
CASE this.CodePage = 620 && Mazovia (Polish) MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 620 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 737 && Greek MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 737 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 852 && Eastern European MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 852 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 857 && Turkish MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 857 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 861 && Icelandic MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 861 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 865 && Nordic MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 865 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 866 && Russian MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 866 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 874 && Thai Windows
CREATE CURSOR xl_strings CODEPAGE = 874 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 895 && Kamenicky (Czech) MS-DOS
CREATE CURSOR xl_strings CODEPAGE = 895 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 932 && Japanese Windows
CREATE CURSOR xl_strings CODEPAGE = 932 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 936 && Chinese Simplified (PRC, Singapore) Windows
CREATE CURSOR xl_strings CODEPAGE = 936 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 949 &&Korean Windows
CREATE CURSOR xl_strings CODEPAGE = 949 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 950 && Traditional Chinese (Hong Kong SAR, Taiwan) Windows
CREATE CURSOR xl_strings CODEPAGE = 950 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 1250 && Eastern European Windows
CREATE CURSOR xl_strings CODEPAGE = 1250 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 1251 && Russian Windows
CREATE CURSOR xl_strings CODEPAGE = 1251 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 1252 && Windows ANSI
CREATE CURSOR xl_strings CODEPAGE = 1252 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 1253 && Greek Windows
CREATE CURSOR xl_strings CODEPAGE = 1253 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 1254 && Turkish Windows
CREATE CURSOR xl_strings CODEPAGE = 1254 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 1255 && Hebrew Windows
CREATE CURSOR xl_strings CODEPAGE = 1255 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CASE this.CodePage = 1256 && Arabic Windows
CREATE CURSOR xl_strings CODEPAGE = 1256 (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
OTHERWISE
CREATE CURSOR xl_strings (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
ENDCASE
INDEX ON BINTOC(workbook)+BINTOC(id) TAG id FOR !DELETED()
INDEX ON BINTOC(workbook)+PADL(id, 10, '0') TAG sortorder FOR !DELETED()
INDEX ON BINTOC(workbook)+checksum TAG stringndx
INDEX ON workbook TAG workbook
CREATE CURSOR xl_strformat (workbook I, id I, index I, stringxml M, stringval M, fbold L, fitalic L, fcolor I, fname C(100), fsize N(5,1), uline C(16), strkthr L, ;
fvpos C(11), theme I, tint F(20,15), indexed I, presvspace L)
INDEX ON BINTOC(workbook)+BINTOC(id)+PADL(index, 10, '0') TAG sortorder FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(id)+BINTOC(index) TAG id FOR !DELETED()
CREATE CURSOR xl_workbooks (workbook I AUTOINC NEXTVALUE 1, wbname C(200), filepath C(200), fullname C(240))
INDEX ON BINTOC(workbook) TAG workbook
INDEX ON UPPER(fullname) TAG fullname
INDEX ON PADR(UPPER(ALLTRIM(wbname)), 200, "_") TAG wbname
CREATE CURSOR xl_sheets (workbook I, sheet I, shname C(30), state I, mleft N(6,3), mright N(6,3), mtop N(6,3), mbot N(6,3), mheader N(6,3), ;
mfooter N(6,3), shdeleted L, xsplit I, ysplit I, prnorient I, papersize I, paperwidth I, paperheight I, ;
paperdimen C(2), scale I, fittowidth I, fittoheight I, tabcolorndx I, tabcolorrgb C(8))
INDEX ON sheet TAG sheet
INDEX ON workbook TAG workbook
INDEX ON BINTOC(workbook)+UPPER(ALLTRIM(shname)) TAG shname
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheetndx FOR !DELETED()
CREATE CURSOR xl_cells (workbook I, sheet I, cellrow I, cellcol I, cellvalue C(25), datatype C(1), cellformula M, stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
INDEX ON sheet TAG sheet
INDEX ON cellrow TAG cellrow
INDEX ON cellcol TAG cellcol
INDEX ON workbook TAG workbook
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(cellrow)+BINTOC(cellcol) TAG reverse DESCENDING
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(cellrow)+BINTOC(cellcol) TAG cellindex CANDIDATE
CREATE CURSOR xl_cellxfs (workbook I, id I, numFmtId I, fontId I, fillId I, borderId I, halign C(8), valign C(8), indent I, wraptext I, rotation I)
INDEX ON BINTOC(workbook)+BINTOC(id) TAG id FOR !DELETED()
INDEX ON BINTOC(workbook)+PADL(id, 10, '0') TAG sortorder FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(numFmtId)+BINTOC(fontId)+BINTOC(fillId)+BINTOC(borderId)+BINTOC(indent)+BINTOC(wraptext)+BINTOC(rotation)+ALLTRIM(halign)+ALLTRIM(valign) TAG cellxfs FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(fontId)+BINTOC(fillId)+BINTOC(borderId)+BINTOC(indent)+BINTOC(wraptext)+BINTOC(rotation)+ALLTRIM(halign)+ALLTRIM(valign) TAG cellformat FOR !DELETED()
CREATE CURSOR xl_fonts (workbook I, id I, fname C(100), fsize N(5,1), fbold L, fitalic L, fcolor I, uline C(16), strkthr L, ;
fvpos C(11), theme I, tint F(20,15), indexed I)
INDEX ON BINTOC(workbook)+fname + STR(fsize, 5, 1) + TRANSFORM(fbold) + TRANSFORM(fitalic) + PADL(fcolor, 15) + uline + TRANSFORM(strkthr) + fvpos TAG cellformat
INDEX ON BINTOC(workbook)+PADL(id, 10, '0') TAG sortorder FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(id) TAG id FOR !DELETED()
CREATE CURSOR xl_fills (workbook I, id I, fgcolor I, bgcolor I, patttype C(25), theme I, tint F(20,15), fgindexed I, bgindexed I)
INDEX ON BINTOC(workbook)+BINTOC(fgcolor)+BINTOC(bgcolor)+patttype TAG fillcolor
INDEX ON BINTOC(workbook)+PADL(id, 10, '0') TAG sortorder FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(id) TAG id FOR !DELETED()
CREATE CURSOR xl_borders (workbook I, id I, lstyle C(20), lcolor I, ltheme I, ltint I, lindexed I, rstyle C(20), rcolor I, rtheme I, rtint I, rindexed I, ;
tstyle C(20), tcolor I, ttheme I, ttint I, tindexed I, bstyle C(20), bcolor I, btheme I, btint I, bindexed I, ;
dstyle C(20), dcolor I, dtheme I, dtint I, dindexed I, diagdn I, diagup I, theme I, tint F(20,15))
INDEX ON BINTOC(workbook) + ALLTRIM(lstyle) + BINTOC(lcolor) + ALLTRIM(rstyle) + BINTOC(rcolor) + ALLTRIM(tstyle) + BINTOC(tcolor) + ALLTRIM(bstyle) + BINTOC(bcolor) + ;
ALLTRIM(dstyle) + BINTOC(dcolor) + BINTOC(diagdn) + BINTOC(diagup) TAG cellborder
INDEX ON BINTOC(workbook)+PADL(id, 10, '0') TAG sortorder FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(id) TAG id FOR !DELETED()
CREATE CURSOR xl_mergecells (workbook I, sheet I, begrow I, begcol I, endrow I, endcol I)
INDEX ON workbook TAG workbook
INDEX ON sheet TAG sheet
INDEX ON begrow TAG begrow
INDEX ON begcol TAG begcol
INDEX ON endrow TAG endrow
INDEX ON endcol TAG endcol
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(begrow)+BINTOC(begcol) TAG mergecell FOR !DELETED()
CREATE CURSOR xl_colwidths (workbook I, sheet I, column I, width N(16,9), bestfit L)
INDEX ON sheet TAG sheet
INDEX ON column TAG column
INDEX ON workbook TAG workbook
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(column) TAG shcolumn FOR !DELETED()
CREATE CURSOR xl_hdrfooterdefn (workbook I, sheet I, alignmargin L, difffirstpg L, diffoddeven L, scalewdoc L)
INDEX ON workbook TAG workbook
INDEX ON sheet TAG sheet
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG wbsheet FOR !DELETED()
CREATE CURSOR xl_hdrfootertext (workbook I, sheet I, page I, section I, text C(200), fontname C(50), fontsize I, fontstyle I, fontcolor I)
INDEX ON workbook TAG workbook
INDEX ON sheet TAG sheet
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(page)+BINTOC(section) TAG hdrfootr FOR !DELETED()
CREATE CURSOR xl_rowheights (workbook I, sheet I, row I, height N(14,7))
INDEX ON workbook TAG workbook
INDEX ON sheet TAG sheet
INDEX ON row TAG row
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(row) TAG shrow FOR !DELETED()
CREATE CURSOR xl_validation (workbook I, sheet I, validndx I AUTOINC NEXTVALUE 1, vtype I, vstyle I, voperator I, errmsg C(100), errtitle C(100), ;
allowblank L, showinpmsg L, showerrmsg L, vprompt C(100), formula L, formula1 C(254), formula2 C(254))
INDEX ON BINTOC(validndx) TAG validndx FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG wbshindex FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(validndx) TAG validindex FOR !DELETED()
INDEX ON LEFT(formula1, 240) TAG formula1 FOR !DELETED()
INDEX ON LEFT(formula2, 240) TAG formula2 FOR !DELETED()
CREATE CURSOR xl_namerange (workbook I, rname C(50), scope I, comment C(254), sheet I, begrow I, begcol I, endrow I, endcol I)
INDEX ON BINTOC(workbook)+rname TAG wbrname FOR !DELETED()
CREATE CURSOR xl_numfmts (workbook I, id I, tempid I, formatxml M, formatcode M, applydec L)
INDEX ON BINTOC(workbook)+PADL(id, 10, '0') TAG sortorder FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(id) TAG id FOR !DELETED()
CREATE CURSOR xl_rows (workbook I, sheet I, row I, maxcol I)
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(row) TAG id FOR !DELETED()
CREATE CURSOR xl_ndxcolors (workbook I, indexid I, rgbcolor C(8))
INDEX ON BINTOC(workbook)+rgbcolor TAG rgbcolor FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(indexid) TAG indexid FOR !DELETED()
CREATE CURSOR xl_mrucolors (workbook I, indexid I, rgbcolor C(8))
INDEX ON BINTOC(workbook)+rgbcolor TAG rgbcolor FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(indexid) TAG indexid FOR !DELETED()
CREATE CURSOR xl_relationships (workbook I, sheet I, relid I, reltype C(20), target C(240))
INDEX ON BINTOC(workbook)+BINTOC(relid) TAG relid FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheet FOR !DELETED()
INDEX ON BINTOC(workbook)+reltype TAG reltype FOR !DELETED()
CREATE CURSOR xl_extsheets (workbook I, extid I, relid I, sheetname C(30))
INDEX ON BINTOC(workbook)+BINTOC(extid) TAG extid FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(extid)+BINTOC(relid) TAG relid FOR !DELETED()
CREATE CURSOR xl_extcells (workbook I, extid I, cellrow I, cellcol I, cellvalue M)
INDEX ON BINTOC(workbook)+BINTOC(extid) TAG extid FOR !DELETED()
*INDEX ON BINTOC(workbook)+BINTOC(extid)+BINTOC(relid) TAG relid FOR !DELETED()
ENDPROC
PROTECTED PROCEDURE createworkingdirectories && Creates the working directories for the XML files
LOCAL lcDir, loException
lcDir = ADDBS(SYS(2023)) + SYS(2015)
TRY
MKDIR (lcDir)
MKDIR (lcDir + "\_rels")
MKDIR (lcDir + "\docProps")
MKDIR (lcDir + "\xl")
MKDIR (lcDir + "\xl\_rels")
MKDIR (lcDir + "\xl\worksheets")
CATCH TO loException
lcDir = .NULL.
ENDTRY
RETURN ADDBS(lcDir)
ENDPROC
PROCEDURE debugcursorstofile && Debugging use for saving the internal cursors to a text file
LPARAMETERS tcStemName
LOCAL lnNumFlds, lcField, lcLineText, lnFld, lcFileName
LOCAL ARRAY laFields[1, 18]
SELECT xl_workbooks
SET ORDER TO TAG workbook
lnNumFlds = AFIELDS(laFields, "xl_workbooks")
lcFileText = "Cursor: xl_workbooks" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_workbooks.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_workbooks.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_sheets
SET ORDER TO TAG sheetndx
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_sheets")
lcFileText = lcFileText + "Cursor: xl_sheets" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_sheets.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_sheets.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_cells
SET ORDER TO TAG cellindex
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_cells")
lcFileText = lcFileText + "Cursor: xl_cells" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_cells.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_cells.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_strings
SET ORDER TO TAG stringid
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_strings")
lcFileText = lcFileText + "Cursor: xl_strings" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_strings.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_strings.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_mergecells
SET ORDER TO TAG mergecell
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_mergecells")
lcFileText = lcFileText + "Cursor: xl_mergecells" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_mergecells.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_mergecells.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_colwidths
SET ORDER TO TAG shcolumn
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_colwidths")
lcFileText = lcFileText + "Cursor: xl_colwidths" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_colwidths.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_colwidths.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_fonts
SET ORDER TO TAG id
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_fonts")
lcFileText = lcFileText + "Cursor: xl_fonts" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_fonts.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_fonts.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_fills
SET ORDER TO TAG id
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_fills")
lcFileText = lcFileText + "Cursor: xl_fills" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_fills.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_fills.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_numfmts
SET ORDER TO TAG id
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_numfmts")
lcFileText = lcFileText + "Cursor: xl_numfmts" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_numfmts.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_numfmts.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_borders
SET ORDER TO TAG id
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_borders")
lcFileText = lcFileText + "Cursor: xl_borders" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_borders.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_borders.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_rowheights
SET ORDER TO TAG shrow
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_rowheights")
lcFileText = lcFileText + "Cursor: xl_rowheights" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_rowheights.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_rowheights.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_hdrfooterdefn
SET ORDER TO TAG wbsheet
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_hdrfooterdefn")
lcFileText = lcFileText + "Cursor: xl_hdrfooterdefn" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_hdrfooterdefn.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_hdrfooterdefn.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
SELECT xl_hdrfootertext
SET ORDER TO TAG hdrfootr
lcFileName = tcStemName + " " + ALIAS() + ".txt"
LIST TO FILE (lcFileName) NOCONSOLE
lnNumFlds = AFIELDS(laFields, "xl_hdrfootertext")
lcFileText = lcFileText + "Cursor: xl_hdrfootertext" + CRLF
SCAN
lcField = LOWER(laFields[1, 1])
lcLineText = lcField + ": " + TRANSFORM(xl_hdrfootertext.&lcField)
FOR lnFld=2 TO lnNumFlds
lcField = LOWER(laFields[lnFld, 1])
lcLineText = lcLineText + "; " + lcField + ": " + TRANSFORM(xl_hdrfootertext.&lcField)
ENDFOR
lcFileText = lcFileText + lcLineText + CRLF
ENDSCAN
lcFileText = lcFileText + CRLF + CRLF + CRLF
SET ORDER TO
lcFileName = tcStemName + " Cursors.txt"
STRTOFILE(lcFileText, lcFileName)
ENDPROC
PROCEDURE debugoutput && Limited functions for debugging
LOCAL lnWb, lnSh
lnWb = this.CreateWorkbook("ExcelDebug.xlsx")
lnSh = this.AddSheet(lnWb, "Debug Output")
this.SetCellValue(lnWb, lnSh, 1, 1, "Test string 1")
this.SetCellValue(lnWb, lnSh, 2, 1, "Test string 2")
this.SetCellValue(lnWb, lnSh, 3, 1, "Test string 3")
this.SetCellValue(lnWb, lnSh, 4, 1, "Test string 4")
this.SetCellValue(lnWb, lnSh, 5, 1, "Test string 5")
this.SetCellValue(lnWb, lnSh, 8, 1, "This is a long Test string for word-wrapping to occur This is a long Test string for word-wrapping to occur")
this.SetCellWordWrap(lnWb, lnSh, 8, 1, True)
this.SetRowHeight(lnWb, lnSh, 8, 75)
this.SetColumnWidth(lnWb, lnSh, 1, 25)
this.SetCellValue(lnWb, lnSh, 10, 1, DATE(2015, 5, 6))
this.SetCellValue(lnWb, lnSh, 11, 1, DATETIME(2015, 5, 6, 6, 30, 30))
this.SetCellFont(lnWb, lnSh, 1, 1, "Arial", 14, True, , RGB(0,0,255))
this.SetCellFont(lnWb, lnSh, 2, 1, "Times New Roman", , , , RGB(0,0,255))
this.SetCellFont(lnWb, lnSh, 3, 1, "Consolas" , 14, True)
this.SetCellFont(lnWb, lnSh, 4, 1, "Arial", 24, True, True, RGB(0,0,255))
this.SetCellFont(lnWb, lnSh, 5, 1, "Cooper Black" , 12, , , )
this.SetCellBorder(lnWb, lnSh, 2, 1, BORDER_TOP+BORDER_BOTTOM, BORDER_STYLE_THICK, RGB(100,150,200))
this.SetCellBorder(lnWb, lnSh, 5, 1, BORDER_LEFT+BORDER_RIGHT, BORDER_STYLE_DOUBLE, RGB(255,0,0))
this.SetCellFill(lnWb, lnSh, 1, 1, RGB(255,204,153))
this.SetCellFill(lnWb, lnSh, 3, 1, RGB(204,255,255))
this.SaveWorkbook(lnWb)
ENDPROC
PROCEDURE debug_assign
LPARAMETERS tlDebug
IF tlDebug
SET DEBUGOUT TO "VFPXWorkbookXLSXDebug.txt"
ENDIF
this.Debug = tlDebug
ENDPROC
PROTECTED PROCEDURE declaredll && Declares the required support Win32 API
DECLARE Sleep IN kernel32 AS apiSleep INTEGER tnTime
DECLARE INTEGER DeleteFile IN kernel32 AS apiDeleteFile STRING lpFileName
DECLARE INTEGER RemoveDirectory IN kernel32 AS apiRemoveDirectory STRING lpPathName
DECLARE LONG MoveFile IN Win32API AS apiMoveFile STRING SourceFileName, STRING DestFileName
DECLARE INTEGER ShellExecute IN Shell32 AS apiShellExecute LONG nhWnd, STRING lpAction, STRING lpFile, STRING lpParams, STRING lpDirectory, INTEGER nShowCmd
ENDPROC
PROCEDURE deleteallworkbooks && Deletes all workbooks
LOCAL loException
TRY
this.DestroyWorkingCursors()
this.CreateWorkingCursors()
this.InitalizeIdValues()
CATCH TO loException
SET STEP ON
ENDTRY
ENDPROC
PROCEDURE deletesheet && Deletes the sheet from the Workbook
LPARAMETERS tnWB, txSheet
LOCAL lnSheet, lxReturn
lxReturn = False
DO CASE
CASE VARTYPE(txSheet) = "C"
IF SEEK(BINTOC(tnWB)+UPPER(txSheet), "xl_sheets", "shname") .AND. SEEK(BINTOC(tnWB)+BINTOC(xl_sheets.sheet), "xl_relationships", "sheet")
lnSheet = xl_sheets.sheet
REPLACE xl_sheets.shdeleted WITH True IN xl_sheets
DELETE IN xl_sheets
DELETE IN xl_relationships
lxReturn = True
ENDIF
CASE VARTYPE(txSheet) = "N"
IF SEEK(BINTOC(tnWB)+BINTOC(txSheet), "xl_sheets", "sheetndx") .AND. SEEK(BINTOC(tnWB)+BINTOC(xl_sheets.sheet), "xl_relationships", "sheet")
lnSheet = txSheet
REPLACE xl_sheets.shdeleted WITH True IN xl_sheets
DELETE IN xl_sheets
DELETE IN xl_relationships
lxReturn = True
ENDIF
ENDCASE
IF lxReturn
REPLACE xl_cells.celldeleted WITH True FOR workbook = tnWB .AND. sheet = lnSheet IN xl_cells
DELETE FOR workbook = tnWB .AND. sheet = lnSheet IN xl_cells
ENDIF
RETURN lxReturn
ENDPROC
PROCEDURE deleteworkbook && Deletes the selected workbook
LPARAMETERS tnWB
LOCAL llSuccess, lnNdx
TRY
REPLACE xl_sheets.shdeleted WITH True FOR workbook = tnWB IN xl_sheets
REPLACE xl_cells.celldeleted WITH True FOR workbook = tnWB IN xl_cells
DELETE FOR workbook = tnWB IN xl_workbooks
DELETE FOR workbook = tnWB IN xl_sheets
DELETE FOR workbook = tnWB IN xl_cells
DELETE FOR workbook = tnWB IN xl_strformat
DELETE FOR workbook = tnWB IN xl_strings
DELETE FOR workbook = tnWB IN xl_cellxfs
DELETE FOR workbook = tnWB IN xl_fonts
DELETE FOR workbook = tnWB IN xl_fills
DELETE FOR workbook = tnWB IN xl_borders
DELETE FOR workbook = tnWB IN xl_mergecells
DELETE FOR workbook = tnWB IN xl_colwidths
DELETE FOR workbook = tnWB IN xl_hdrfooterdefn
DELETE FOR workbook = tnWB IN xl_hdrfootertext
DELETE FOR workbook = tnWB IN xl_rowheights
DELETE FOR workbook = tnWB IN xl_validation
DELETE FOR workbook = tnWB IN xl_namerange
DELETE FOR workbook = tnWB IN xl_numfmts
DELETE FOR workbook = tnWB IN xl_rows
DELETE FOR workbook = tnWB IN xl_ndxcolors
DELETE FOR workbook = tnWB IN xl_mrucolors
DELETE FOR workbook = tnWB IN xl_relationships
DELETE FOR workbook = tnWB IN xl_extsheets
DELETE FOR workbook = tnWB IN xl_extcells
lnNdx = ASCAN(this.LastBorderId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastBorderId, lnNdx)
lnNdx = ALEN(this.LastBorderId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastBorderId[lnNdx, 2]
ELSE
this.LastBorderId[1, 1] = 0 && Workbook Id
this.LastBorderId[1, 2] = 0 && Last Border Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastCellXfsId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastCellXfsId, lnNdx)
lnNdx = ALEN(this.LastCellXfsId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastCellXfsId[lnNdx, 2]
ELSE
this.LastCellXfsId[1, 1] = 0 && Workbook Id
this.LastCellXfsId[1, 2] = 0 && Last CellXfs Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastFillId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastFillId, lnNdx)
lnNdx = ALEN(this.LastFillId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastFillId[lnNdx, 2]
ELSE
this.LastFillId[1, 1] = 0 && Workbook Id
this.LastFillId[1, 2] = 0 && Last Fill Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastFontId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastFontId, lnNdx)
lnNdx = ALEN(this.LastFontId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastFontId[lnNdx, 2]
ELSE
this.LastFontId[1, 1] = 0 && Workbook Id
this.LastFontId[1, 2] = 0 && Last Font Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastIndexColorId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastIndexColorId, lnNdx)
lnNdx = ALEN(this.LastIndexColorId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastIndexColorId[lnNdx, 2]
ELSE
this.LastIndexColorId[1, 1] = 0 && Workbook Id
this.LastIndexColorId[1, 2] = 0 && Last IndexColor Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastMruColorId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastMruColorId, lnNdx)
lnNdx = ALEN(this.LastMruColorId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastMruColorId[lnNdx, 2]
ELSE
this.LastMruColorId[1, 1] = 0 && Workbook Id
this.LastMruColorId[1, 2] = 0 && Last mruColor Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastNumFmtId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastNumFmtId, lnNdx)
lnNdx = ALEN(this.LastNumFmtId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastNumFmtId[lnNdx, 2]
ELSE
this.LastNumFmtId[1, 1] = 0 && Workbook Id
this.LastNumFmtId[1, 2] = 0 && Last NumFmt Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastRelationId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastRelationId, lnNdx)
lnNdx = ALEN(this.LastRelationId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastRelationId[lnNdx, 2]
ELSE
this.LastRelationId[1, 1] = 0 && Workbook Id
this.LastRelationId[1, 2] = 0 && Last Relationship Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastSheetId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastSheetId, lnNdx)
lnNdx = ALEN(this.LastSheetId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastSheetId[lnNdx, 2]
ELSE
this.LastSheetId[1, 1] = 0 && Workbook Id
this.LastSheetId[1, 2] = 0 && Last Sheet Id
ENDIF
ENDIF
lnNdx = ASCAN(this.LastStringId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
ADEL(this.LastStringId, lnNdx)
lnNdx = ALEN(this.LastStringId, 1) - 1
IF lnNdx > 0
DIMENSION this.LastStringId[lnNdx, 2]
ELSE
this.LastStringId[1, 1] = 0 && Workbook Id
this.LastStringId[1, 2] = 0 && Last String Id
ENDIF
ENDIF
llSuccess = True
CATCH TO loException
SET STEP ON
llSuccess = False
ENDTRY
RETURN llSuccess
ENDPROC
PROCEDURE demo && Demo for the features of this class
LOCAL lnWb, lnSh1, lnRow, lnCol, lnSh2, lnSh3, lnSh4, lnCnt, lnFormat, llBoolean, lcNamedRange
LOCAL lnSh6, lnSh5, loInline, lnStyle1, lnStyle2, lnBorders, lcString
lnWb = this.CreateWorkbook("ExcelTest.xlsx")
IF lnWb = 0
RETURN False
ENDIF
lnSh1 = this.AddSheet(lnWb, "Test Sheet 1")
IF lnSh1 = 0
RETURN False
ENDIF
this.FreezePanes(lnWb, lnSh1, 1, 2)
llBoolean = True
FOR lnRow=1 TO 10
FOR lnCol=1 TO 9
this.SetCellValue(lnWb, lnSh1, lnRow, lnCol, SYS(2015))
ENDFOR
llBoolean = !llBoolean
this.SetCellValue(lnWb, lnSh1, lnRow, 10, llBoolean)
ENDFOR
this.SetRowHeight(lnWb, lnSh1, 6, 25)
*-* Example of cell styles
lnStyle1 = this.CreateFormatStyle(lnWB) && Create the base style definition
lnBorders = BORDER_LEFT + BORDER_RIGHT + BORDER_TOP + BORDER_BOTTOM
this.AddStyleBorders(lnWB, lnStyle1, lnBorders, BORDER_STYLE_THIN, RGB(16,100,200))
this.AddStyleFont(lnWB, lnStyle1, "Times New Roman", 14, False, False, RGB(0,0,255))
this.SetCellStyleRange(lnWB, lnSh1, 2, 1, 2, 9, lnStyle1)
lnStyle2 = this.CreateFormatStyle(lnWB) && Create the base style definition
lnBorders = BORDER_BOTTOM
this.AddStyleBorders(lnWB, lnStyle2, lnBorders, BORDER_STYLE_THICK, RGB(16,100,200))
this.AddStyleFont(lnWB, lnStyle2, "Arial", 16, True, False)
this.SetCellStyleRange(lnWB, lnSh1, 4, 1, 4, 9, lnStyle2)
*-* * Indentation examples [OLD WAY - DEPRICATED METHODS]
*-* this.SetCellIndent(lnWb, lnSh1, 2, 6, 3)
*-* this.SetCellIndent(lnWb, lnSh1, 4, 6, 3)
*-* this.SetCellIndent(lnWb, lnSh1, 6, 6, 3)
*-* this.SetCellIndent(lnWb, lnSh1, 8, 6, 3)
*-* this.SetCellIndent(lnWb, lnSh1, 10, 6, 3)
*-*
*-* * tnWB, tnSheet, tnCellRow, tnCellCol, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos
*-* this.SetCellFont(lnWb, lnSh1, 1, 1, "Arial", 14, True, True, RGB(0,0,255))
*-* this.SetCellFont(lnWb, lnSh1, 2, 1, "Times New Roman", , , , RGB(0,0,255))
*-* this.SetCellFont(lnWb, lnSh1, 3, 1, , 14, True)
*-* this.SetCellFont(lnWb, lnSh1, 4, 1, "Arial", 14, True, True, RGB(0,0,255))
*-* this.SetCellFont(lnWb, lnSh1, 6, 1, , , , , , 'single')
*-* this.SetCellFont(lnWb, lnSh1, 7, 1, , , , , , 'double')
*-* this.SetCellFont(lnWb, lnSh1, 8, 1, , , , , , , True)
*-* this.SetCellFont(lnWb, lnSh1, 9, 1, , , , , , , , "superscript")
*-*
*-* * New procedure each line is drawed with the same style and color
*-* this.SetCellBorder(lnWb, lnSh1, 3, 4, 63, BORDER_STYLE_THIN, RGB(16,100,200))
*-* this.SetCellBorder(lnWb, lnSh1, 3, 6, 31, BORDER_STYLE_THICK, RGB(100,150,200))
*-* this.SetCellBorder(lnWb, lnSh1, 3, 8, 47, BORDER_STYLE_DOUBLE, RGB(200,150,100))
*-* this.SetCellBorder(lnWb, lnSh1, 3, 4, 8, BORDER_STYLE_THIN, RGB(16,100,200))
*-*
*-* this.SetCellWordWrapRange(lnWb, lnSh1, 1, 1, 10, 9, True)
*-*
*-* * Old procedure - each line can have a different style or color
*-* this.SetCellBorderEx(lnWb, lnSh1, 5, 2, 'thin',,'thin',,'thick',,'thick')
*-* this.SetCellBorderEx(lnWb, lnSh1, 9, 2, ,,,,'double',255,'thick',RGB(255,0,255))
* Example of setting inline text formatting
loInline = this.CreateInLineFormatText(lnWb, "This is an in-line formatted text string")
loInline = this.AddInLineFontObject(loInline, 1, 4, "Arial Black", 16)
loInline = this.AddInLineFontObject(loInline, 5, 15, "Times New Roman", 14, RGB(255,0,0), .T.)
loInline = this.AddInLineFontObject(loInline, 20, 21, "Arial", 12)
this.SetCellInLineFormatText(lnWb, lnSh1, 16, 1, loInline)
* Rotated text
this.SetCellValue(lnWb, lnSh1, 17, 1, "This text is rotated 45 degrees")
this.SetCellTextRotation(lnWb, lnSh1, 17, 1, 45)
this.SetCellValue(lnWb, lnSh1, 18, 1, "This text is rotated -45 degrees")
this.SetCellTextRotation(lnWb, lnSh1, 18, 1, -45)
* Similar text
this.SetCellValue(lnWb, lnSh1, 15, 7, "This text is similar")
this.SetCellValue(lnWb, lnSh1, 16, 7, "This text is similar to the one above but is longer length")
*-* Very long text
lcString = "Addtionally, there is a new method for reading an existing XLSX file into the working cursors and then supporting methods to extract the individual cell values and formatting. However, this XLSX read method is still in development "
this.SetCellValue(lnWb, lnSh1, 22, 1, lcString)
lcString = lcString + "and not yet ready for use. This is the method OpenXlsxWorkbook() - only use if you want to try it but the method will not necessarily read all the numeric"
this.SetCellValue(lnWb, lnSh1, 23, 1, lcString)
lcString = lcString + " or date values correctly at this point. I did not want to hold this release of VFPxWorkbookXlsx class for the completion of the reading of the XLSX file due to the other bug fixes."
this.SetCellValue(lnWb, lnSh1, 24, 1, lcString)
* Text with ASCII > 128
this.SetCellValue(lnWb, lnSh1, 19, 1, "This text that has ASCII chars > 128:" + CRLF + "Trademark symbol: " + CHR(174) + CRLF + "Copyright symbol: " + CHR(169))
* Column Width examples
this.SetColumnWidth(lnWb, lnSh1, 1, 25)
this.SetColumnWidth(lnWb, lnSh1, 2, 15)
this.SetColumnWidth(lnWb, lnSh1, 3, 15)
this.SetColumnWidth(lnWb, lnSh1, 4, 20)
this.SetColumnWidth(lnWb, lnSh1, 5, 15)
this.SetColumnWidth(lnWb, lnSh1, 6, 25)
this.SetColumnWidth(lnWb, lnSh1, 9, 15)
*Row inserted
this.InsertRow(lnWb, lnSh1, 5, INSERT_AFTER)
*Column inserted
this.InsertColumn(lnWb, lnSh1, 5, INSERT_RIGHT)
* Sheet setup examples
this.SetPrintOrientation(lnWb, lnSh1, PORTRAIT_PRINT_ORIENTATION)
this.SetPaperSize(lnWb, lnSh1, PAPERSIZE_LEGAL)
this.SetSheetScale(lnWb, lnSh1, 50)
*******************************************************************************
lnSh2 = this.AddSheet(lnWb, "Test Sheet 2")
IF lnSh2 = 0
RETURN False
ENDIF
this.FreezePanes(lnWb, lnSh2, 1)
this.SetCellValue(lnWb, lnSh2, 1, 1, "Column Header 1")
this.SetCellValue(lnWb, lnSh2, 1, 2, "Column Header 2")
this.SetCellValue(lnWb, lnSh2, 1, 3, "Column Header 3")
this.SetCellValue(lnWb, lnSh2, 1, 4, "Column Header 4")
this.SetCellValue(lnWb, lnSh2, 1, 5, "Column Header 5")
this.SetCellFont(lnWb, lnSh2, 1, 1, "Arial", 14, True, False, RGB(255,255,255))
this.SetCellFill(lnWb, lnSh2, 1, 1, RGB(51,102,255))
this.CellFormatPainter(lnWb, lnSh2, 1, 1, 1, 2, 1, 5)
this.SetColumnWidthRange(lnWb, lnSh2, 1, 5, 24)
* Add integer values to cells
FOR lnRow=2 TO 6
FOR lnCol=1 TO 5
this.SetCellValue(lnWb, lnSh2, lnRow, lnCol, lnRow*lnCol)
ENDFOR
ENDFOR
* Add SUM() formula to columns
FOR lnCol=1 TO 5
lcColumn = this.ColumnIndexToAscii(lnCol)
this.SetCellFormula(lnWb, lnSh2, 7, lnCol, "=SUM(" + lcColumn + "2:" + lcColumn + "6)")
ENDFOR
* Add floating point values to cells
FOR lnRow=10 TO 15
FOR lnCol=3 TO 5
this.SetCellValue(lnWb, lnSh2, lnRow, lnCol, lnRow*1.25)
ENDFOR
ENDFOR
* Add AVERAGE(), MAX(), & MIN() formula to columns
this.SetCellFormula(lnWb, lnSh2, 16, 3, "=AVERAGE(C10:C15)")
this.SetCellFormula(lnWb, lnSh2, 16, 4, "=MAX(D10:D15)")
this.SetCellFormula(lnWb, lnSh2, 16, 5, "=MIN(E10:E15)")
this.SetCellValue(lnWb, lnSh2, 16, 1, "This row contains calculated formulas -->")
* Merge some cells
this.MergeCells(lnWb, lnSh2, 2, 8, 2, 10)
this.MergeCells(lnWb, lnSh2, 3, 8, 3, 10)
this.MergeCells(lnWb, lnSh2, 5, 8, 10, 10)
this.SetCellValue(lnWb, lnSh2, 2, 8, "Merged H2:J2")
this.SetCellValue(lnWb, lnSh2, 3, 8, "Merged H3:J3")
this.SetCellValue(lnWb, lnSh2, 5, 8, "Merged H5:J10")
this.SetCustomPaperSize(lnWb, lnSh2, 841, 1189, "mm")
this.SetHeaderFooterSetup(lnWb, lnSh2, False, True, False, False)
this.SetHeaderFooterText(lnWb, lnSh2, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_HDR_CENTER, "This is First Page", "Arial", 16, HEADERFOOTER_FONT_STYLE_BOLD, RGB(255,0,0))
this.SetHeaderFooterText(lnWb, lnSh2, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_HDR_CENTER, "These are Additional Pages", "Arial", 10, HEADERFOOTER_FONT_STYLE_BOLD, RGB(0,128,0))
this.SetHeaderFooterText(lnWb, lnSh2, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_FTR_CENTER, "Page &amp;P of &amp;N", "Arial", 16, HEADERFOOTER_FONT_STYLE_BOLD)
*******************************************************************************
lnSh3 = this.AddSheet(lnWb, "Number Formats")
IF lnSh3 = 0
RETURN False
ENDIF
lnFormat = this.AddNumericFormat(lnWb, '[Green]"$"#,##0.00;[Red]"$"#,##0.00')
*lnFormat = this.AddCustomNumericFormat(lnWb, '[Green]"$"#,##0.00', '[Red]"$"#,##0.00')
this.SetCellValue(lnWb, lnSh3, 1, 1, 56.558)
this.SetCellValue(lnWb, lnSh3, 1, 2, "Custom defined format: " + this.GetCustomNumericFormat(lnWb, lnFormat))
this.SetCellNumberFormat(lnWb, lnSh3, 1, 1, lnFormat)
this.SetColumnWidth(lnWb, lnSh3, 1, 18)
this.SetColumnWidth(lnWb, lnSh3, 2, 60)
this.SetCellValue(lnWb, lnSh3, 3, 1, 14)
this.SetCellValue(lnWb, lnSh3, 3, 2, "Integer format")
this.SetCellNumberFormat(lnWb, lnSh3, 3, 1, CELL_FORMAT_INTEGER)
this.SetCellValue(lnWb, lnSh3, 4, 1, 13355.2)
this.SetCellValue(lnWb, lnSh3, 4, 2, "Float format")
this.SetCellNumberFormat(lnWb, lnSh3, 4, 1, CELL_FORMAT_FLOAT)
this.SetCellValue(lnWb, lnSh3, 5, 1, 16898)
this.SetCellValue(lnWb, lnSh3, 5, 2, "Integer format, comma separated")
this.SetCellNumberFormat(lnWb, lnSh3, 5, 1, CELL_FORMAT_COMMA_INTEGER)
this.SetCellValue(lnWb, lnSh3, 6, 1, 13355.20)
this.SetCellValue(lnWb, lnSh3, 6, 2, "Float format, comma separated")
this.SetCellNumberFormat(lnWb, lnSh3, 6 , 1, CELL_FORMAT_COMMA_FLOAT)
this.SetCellValue(lnWb, lnSh3, 7, 1, -13355.20)
this.SetCellValue(lnWb, lnSh3, 7, 2, "Currency format, negative in parenthesis")
this.SetCellNumberFormat(lnWb, lnSh3, 7, 1, CELL_FORMAT_CURRENCY_PAREN)
this.SetCellValue(lnWb, lnSh3, 8, 1, -13355.20)
this.SetCellValue(lnWb, lnSh3, 8, 2, "Currency format, negative red in parenthesis")
this.SetCellNumberFormat(lnWb, lnSh3, 8, 1, CELL_FORMAT_CURRENCY_RED_PAREN)
this.SetCellValue(lnWb, lnSh3, 10, 1, 0.55)
this.SetCellValue(lnWb, lnSh3, 10, 2, "Percent format, integer")
this.SetCellNumberFormat(lnWb, lnSh3, 10, 1, CELL_FORMAT_PERCENT_INTEGER)
this.SetCellValue(lnWb, lnSh3, 11, 1, 0.5534)
this.SetCellValue(lnWb, lnSh3, 11, 2, "Percent format, float")
this.SetCellNumberFormat(lnWb, lnSh3, 11, 1, CELL_FORMAT_PERCENT_FLOAT)
this.SetCellValue(lnWb, lnSh3, 13, 1, 456800000.00)
this.SetCellValue(lnWb, lnSh3, 13, 2, "Exponential format")
this.SetCellNumberFormat(lnWb, lnSh3, 13, 1, CELL_FORMAT_EXPONENT)
this.SetCellValue(lnWb, lnSh3, 15, 1, 0.25)
this.SetCellValue(lnWb, lnSh3, 15, 2, "Fraction format, single place")
this.SetCellNumberFormat(lnWb, lnSh3, 15, 1, CELL_FORMAT_FRACTION_1)
this.SetCellValue(lnWb, lnSh3, 16, 1, 0.3125)
this.SetCellValue(lnWb, lnSh3, 16, 2, "Fraction format, 2 places")
this.SetCellNumberFormat(lnWb, lnSh3, 16, 1, CELL_FORMAT_FRACTION_2)
this.SetCellValue(lnWb, lnSh3, 18, 1, DATE())
this.SetCellValue(lnWb, lnSh3, 18, 2, "Default date format")
this.SetCellNumberFormat(lnWb, lnSh3, 18, 1, CELL_FORMAT_DATE_DMMMYY)
this.SetCellValue(lnWb, lnSh3, 19, 1, DATE())
this.SetCellValue(lnWb, lnSh3, 19, 2, "Date format, d-mmm-yy")
this.SetCellNumberFormat(lnWb, lnSh3, 19, 1, CELL_FORMAT_DATE_DMMMYY)
this.SetCellValue(lnWb, lnSh3, 20, 1, DATE())
this.SetCellValue(lnWb, lnSh3, 20, 2, "Date format, d-mmm")
this.SetCellNumberFormat(lnWb, lnSh3, 20, 1, CELL_FORMAT_DATE_DMMM)
this.SetCellValue(lnWb, lnSh3, 21, 1, DATE())
this.SetCellValue(lnWb, lnSh3, 21, 2, "Date format, mmm-yy")
this.SetCellNumberFormat(lnWb, lnSh3, 21, 1, CELL_FORMAT_DATE_MMMYY)
this.SetCellValue(lnWb, lnSh3, 23, 1, 0.35733796296296294)
this.SetCellValue(lnWb, lnSh3, 23, 2, "Time format, h:mm AM/PM")
this.SetCellNumberFormat(lnWb, lnSh3, 23, 1, CELL_FORMAT_TIME_HMMAMPM)
this.SetCellValue(lnWb, lnSh3, 24, 1, 0.35733796296296294)
this.SetCellValue(lnWb, lnSh3, 24, 2, "Time format, h:mm:ss AM/PM")
this.SetCellNumberFormat(lnWb, lnSh3, 24, 1, CELL_FORMAT_TIME_HMMSSAMPM)
this.SetCellValue(lnWb, lnSh3, 25, 1, 0.35733796296296294)
this.SetCellValue(lnWb, lnSh3, 25, 2, "Time format, h:mm")
this.SetCellNumberFormat(lnWb, lnSh3, 25, 1, CELL_FORMAT_TIME_HMM)
this.SetCellValue(lnWb, lnSh3, 26, 1, 0.35733796296296294)
this.SetCellValue(lnWb, lnSh3, 26, 2, "Time format, h:mm:ss")
this.SetCellNumberFormat(lnWb, lnSh3, 26, 1, CELL_FORMAT_TIME_HMMSS)
this.SetCellValue(lnWb, lnSh3, 28, 1, DATETIME())
this.SetCellValue(lnWb, lnSh3, 28, 2, "Date-Time format, m/d/yy h:mm")
this.SetCellNumberFormat(lnWb, lnSh3, 28, 1, CELL_FORMAT_DATETIME_MDYYHMM)
this.SetCellValue(lnWb, lnSh3, 29, 1, DATETIME())
this.SetCellValue(lnWb, lnSh3, 29, 2, "Date-Time format, [$-409]dd/mmm/yyyy\ h:mm\ AM/PM;@")
this.SetCellNumberFormat(lnWb, lnSh3, 29, 1, CELL_FORMAT_DATETIME_DDMMMYYYY_TTAM)
this.SetCellValue(lnWb, lnSh3, 30, 1, DATETIME())
this.SetCellValue(lnWb, lnSh3, 30, 2, "Date-Time format, dd/mmm/yyyy\ h:mm;@")
this.SetCellNumberFormat(lnWb, lnSh3, 30, 1, CELL_FORMAT_DATETIME_DDMMMYYYY_TT24)
this.SetCellValue(lnWb, lnSh3, 31, 1, DATETIME())
this.SetCellValue(lnWb, lnSh3, 31, 2, "Date-Time format, [$-409]mmm\ d\,\ yyyy\ h:mm\ AM/PM;@")
this.SetCellNumberFormat(lnWb, lnSh3, 31, 1, CELL_FORMAT_DATETIME_MMMDDYYYY_TTAM)
this.SetCellValue(lnWb, lnSh3, 32, 1, DATETIME())
this.SetCellValue(lnWb, lnSh3, 32, 2, "Date-Time format, [$-409]mmm\ d\,\ yyyy\ h:mm;@")
this.SetCellNumberFormat(lnWb, lnSh3, 32, 1, CELL_FORMAT_DATETIME_MMMDDYYYY_TT24)
this.SetCellValue(lnWb, lnSh3, 33, 1, DATETIME())
this.SetCellValue(lnWb, lnSh3, 33, 2, "Date-Time format, m/d/yy\ h:mm\ AM/PM;@")
this.SetCellNumberFormat(lnWb, lnSh3, 33, 1, CELL_FORMAT_DATETIME_MDYY_TTAM)
this.SetCellValue(lnWb, lnSh3, 34, 1, DATETIME())
this.SetCellValue(lnWb, lnSh3, 34, 2, "Date-Time format, m/d/yy\ h:mm;@")
this.SetCellNumberFormat(lnWb, lnSh3, 34, 1, CELL_FORMAT_DATETIME_MDYY_TT24)
this.SetCellValue(lnWb, lnSh3, 36, 1, -89235)
this.SetCellValue(lnWb, lnSh3, 36, 2, "Numeric format, #,##0;(#,##0)")
this.SetCellNumberFormat(lnWb, lnSh3, 36, 1, CELL_FORMAT_COMMA_INTEGER_PAREN)
this.SetCellValue(lnWb, lnSh3, 37, 1, -12457)
this.SetCellValue(lnWb, lnSh3, 37, 2, "Numeric format, #,##0;[Red](#,##0)")
this.SetCellNumberFormat(lnWb, lnSh3, 37, 1, CELL_FORMAT_COMMA_INTEGER_RED_PAREN)
this.SetCellValue(lnWb, lnSh3, 38, 1, -1245789.22)
this.SetCellValue(lnWb, lnSh3, 38, 2, "Numeric format, #,##0.00;(#,##0.00)")
this.SetCellNumberFormat(lnWb, lnSh3, 38, 1, CELL_FORMAT_COMMA_FLOAT_PAREN)
this.SetCellValue(lnWb, lnSh3, 39, 1, -125896.33)
this.SetCellValue(lnWb, lnSh3, 39, 2, "Numeric format, #,##0.00;[Red](#,##0.00)")
this.SetCellNumberFormat(lnWb, lnSh3, 39, 1, CELL_FORMAT_COMMA_FLOAT_RED_PAREN)
this.SetCellValue(lnWb, lnSh3, 41, 1, 6.25E-2)
this.SetCellValue(lnWb, lnSh3, 41, 2, "Time format")
this.SetCellNumberFormat(lnWb, lnSh3, 41, 1, CELL_FORMAT_TIME_MMSS)
this.SetCellValue(lnWb, lnSh3, 42, 1, 0.35733796296296294)
this.SetCellValue(lnWb, lnSh3, 42, 2, "Time format, [h]:mm:ss")
this.SetCellNumberFormat(lnWb, lnSh3, 42, 1, CELL_FORMAT_TIME_H_MMSS)
this.SetCellValue(lnWb, lnSh3, 44, 1, -45.55)
this.SetCellValue(lnWb, lnSh3, 44, 2, "CELL_FORMAT_CURRENCY_RED")
this.SetCellNumberFormat(lnWb, lnSh3, 44, 1, CELL_FORMAT_CURRENCY_RED)
this.SetCellValue(lnWb, lnSh3, 45, 1, -45.55)
this.SetCellValue(lnWb, lnSh3, 45, 2, "CELL_FORMAT_ACC_CURR_POUNDS")
this.SetCellNumberFormat(lnWb, lnSh3, 45, 1, CELL_FORMAT_ACC_CURR_POUNDS)
this.SetCellValue(lnWb, lnSh3, 46, 1, -45.55)
this.SetCellValue(lnWb, lnSh3, 46, 2, "CELL_FORMAT_ACC_CURR_EURO")
this.SetCellNumberFormat(lnWb, lnSh3, 46, 1, CELL_FORMAT_ACC_CURR_EURO)
this.SetCellValue(lnWb, lnSh3, 47, 1, -45.55)
this.SetCellValue(lnWb, lnSh3, 47, 2, "CELL_FORMAT_CURR_EURO_RED")
this.SetCellNumberFormat(lnWb, lnSh3, 47, 1, CELL_FORMAT_CURR_EURO_RED)
this.SetCellValue(lnWb, lnSh3, 48, 1, -45.55)
this.SetCellValue(lnWb, lnSh3, 48, 2, "CELL_FORMAT_CURR_POUNDS_RED")
this.SetCellNumberFormat(lnWb, lnSh3, 48, 1, CELL_FORMAT_CURR_POUNDS_RED)
this.SetPrintOrientation(lnWb, lnSh3, LANDSCAPE_PRINT_ORIENTATION)
*-* this.SetPrintFitToHeight(lnWb, lnSh3, 2)
*******************************************************************************
lnSh4 = this.AddSheet(lnWb, "Color Sheet")
IF lnSh4 = 0
RETURN False
ENDIF
this.SetCellValue(lnWb, lnSh4, 1, 1, "RGB(51,102,255)")
this.SetCellFill(lnWb, lnSh4, 1, 1, RGB(51,102,255))
this.SetCellValue(lnWb, lnSh4, 1, 2, "RGB(255,0,0)")
this.SetCellFill(lnWb, lnSh4, 1, 2, RGB(255,0,0))
this.SetCellAlignmentRange(lnWb, lnSh4, 1, 1, 1, 2, CELL_HORIZ_ALIGN_CENTER, CELL_VERT_ALIGN_CENTER)
this.SetColumnWidthRange(lnWb, lnSh4, 1, 2, 18)
this.SetRowHeight(lnWb, lnSh4, 1, 60)
*******************************************************************************
lnSh5 = this.AddSheet(lnWb, "Blank Sheet")
*******************************************************************************
lnSh6 = this.AddSheet(lnWb, "List Values", HIDDEN_SHEET_STATE)
IF lnSh6 = 0
RETURN False
ENDIF
this.SetCellValidation(lnWb, lnSh1, 13, 1, LIST_VALID_TYPE, , , , , , , , , "Yes,No,Maybe")
this.SetCellValue(lnWb, lnSh1, 13, 2, "The cell to the left has a droplist validation")
this.SetCellValue(lnWb, lnSh6, 1, 1, "Named Value List")
this.SetCellValue(lnWb, lnSh6, 2, 1, "Named Value 1")
this.SetCellValue(lnWb, lnSh6, 3, 1, "Named Value 2")
this.SetCellValue(lnWb, lnSh6, 4, 1, "Named Value 3")
this.SetCellValue(lnWb, lnSh6, 5, 1, "Named Value 4")
this.SetCellValue(lnWb, lnSh6, 6, 1, "Named Value 5")
this.SetCellValue(lnWb, lnSh6, 7, 1, "Named Value 6")
lcNamedRange = this.AddNamedRange(lnWb, lnSh6, "Named Range", SCOPE_WB_NAMED_RANGE, "This is a comment", 2, 1, 7, 1)
this.SetCellValidation(lnWb, lnSh1, 14, 1, LIST_VALID_TYPE, , , , , , , , , "=" + lcNamedRange)
this.SetCellValue(lnWb, lnSh1, 14, 2, "The cell to the left has a droplist validation based on a Named Range (stored in Hidden Sheet6)")
this.InsertCell(lnWb, lnSh1, 9, 9, INSERT_RIGHT)
this.InsertCell(lnWb, lnSh1, 11, 9, INSERT_BEFORE)
*-* For testing sheet saving only
*this.DeleteSheet(lnWb, lnSh2)
this.SaveWorkbook(lnWb)
IF this.Debug
this.DebugCursorsToFile("ExcelTest")
ENDIF
ENDPROC
PROTECTED PROCEDURE derivesheetname && Derives the sheet name
LPARAMETERS txWB
DO CASE
CASE VARTYPE(txWB) = "C"
lcSheetName = JUSTSTEM(txWB)
CASE VARTYPE(txWB) = "N"
lcSheetName = JUSTSTEM(this.GetWorkbookFileName(txWB))
OTHERWISE
RETURN ""
ENDCASE
RETURN lcSheetName
ENDPROC
PROTECTED PROCEDURE Destroy
SET DEBUGOUT TO
this.DestroyWorkingCursors()
this.OnDestroy()
ENDPROC
PROTECTED PROCEDURE destroyworkingcursors && Destroys the working cursors
TRY
USE IN SELECT('xl_strings')
USE IN SELECT('xl_workbooks')
USE IN SELECT('xl_sheets')
USE IN SELECT('xl_cells')
USE IN SELECT('xl_fonts')
USE IN SELECT('xl_fills')
USE IN SELECT('xl_borders')
USE IN SELECT('xl_mergecells')
USE IN SELECT('xl_colwidths')
USE IN SELECT('xl_hdrfooterdefn')
USE IN SELECT('xl_hdrfootertext')
USE IN SELECT('xl_rowheights')
USE IN SELECT('xl_numfmts')
USE IN SELECT('xl_namerange')
USE IN SELECT('xl_validation')
USE IN SELECT('xl_strformat')
USE IN SELECT('xl_cellxfs')
USE IN SELECT('xl_rows')
USE IN SELECT('xl_ndxcolors')
USE IN SELECT('xl_mrucolors')
USE IN SELECT('xl_relationships')
USE IN SELECT('xl_extsheets')
USE IN SELECT('xl_extcells')
CATCH TO loException
ENDTRY
ENDPROC
PROTECTED PROCEDURE documentation && Documentation of the methods and properties for this class
*-*
*-* Written by: Vilhelm Praisach
*-* Gregory Green
*-*
*-* Release History:
*-*
*-* May 11, 2015 Initial release.
*-* May 12, 2015 Added new methods: SetCellFormatRange, SetCellBorderRange, SaveGridToWorkbook
*-* Added new properties: Title, Subject, CompanyName
*-* Added check in SetCellValue that if a value is being set in a merged cell range then the value is set in the upper
*-* left cell of the merged range
*-* Corrected sheet references when writing the sheet XML
*-* May 27, 2015 Added new methods: ConvertPixelsToExcelUnits, GetWorkbook, GetWorkbookSheets, DeleteWorkbook, DeleteAllWorkbooks,
*-* SetCellAlignment, SetCellNumberDecimals, SetCellNumberFormat, SetCellNumberFormatRange,
*-* SetColumnWidthRange, SetRowHeight, SetRowHeightRange, SetCellWordWrap
*-* Renamed method RemoveSheet to DeleteSheet
*-* Corrected string to XML conversion (was performing a double conversion of the string)
*-* Corrected issue of generated XLSX file being deleted; increase of Sleep() time for file rename
*-* June 1, 2015 Corrected bug in merge cell and cell value assignment (after a merge cell was performed any subsequent sheets
*-* added that had cells in the same merge range with value assignments was not having the values set correctly)
*-* Changed property name ExcelXlsxVersion to ExcelXlsxRelease; this property will give the Release number (integer)
*-* of this class
*-* June 5, 2015 Added to set the default selected table/cursor (value retuned by ALIAS() function) when the default table/cursor
*-* is changed in a method
*-* Added new method: SaveTableToWorkbook
*-* June 8, 2015 No new features. Code was optimized for better performance.
*-*
*-* The first optimization I changed the SetCellValue() code to now always attempt to INSERT first. I added the CANDIDATE
*-* clause to the primary INDEX so that if a cell is already entered, the INSERT command will fail in a TRY-CATCH block
*-* (duplicate KEY); in the CATCH portion I do an update to the cell value. This reduced the time to assign the values
*-* significantly. I had been doing a SEEK() for the cell and updating if found otherwise doing an INSERT
*-*
*-* The second optimization was how I was assigning a string index value. The original code did a SELECT-SQL WITH a MAX()
*-* for the last used index value IN the workbook (strings are universal TO a workbook); I changed to a property value
*-* (array indexed by the workbook number) and then just increment this value as it is used. Great amount of savings here too.
*-*
*-* The LAST optimization was in how the Sheet.xml were being written. I now just do a SCAN across the cells and add to the
*-* XML. I was doing several SQL calls to first get the rows and then SQL calls TO the columns for each row. Again not as
*-* efficient as just SCAN-ENDSCAN on the cells cursor table. Had to build in logic to populate rows that did not have a
*-* cell value assigned but had row height assigned. The SQL coding was easier for this but at a great cost in time.
*-* June 9, 2015 No new features. Bug fix for a nasty crash of Excel when the print or print-preview is selected. Congratulations to
*-* Vilhelm for finding this bug.
*-* July 1, 2015 Corrected return value for AddNumericFormat.
*-* Changed the parameters on AddNumericFormat(); now just pass the numeric format
*-*
*-* Oct 29, 2015 Added new functions for opening an existing workbook (xlsx). Added sheet print formatting methods.
*-*
*-************************************************************************************************************************************
ENDPROC
PROCEDURE freezepanes && Freezes the panes of the sheet
LPARAMETERS tnWB, tnSheet, tnTopRowCount, tnSideColCount
LOCAL lxReturn
DO CASE
CASE PCOUNT() < 3
RETURN False
CASE PCOUNT() = 3
tnSideColCount = 0
ENDCASE
IF VARTYPE(tnTopRowCount) != 'N'
tnTopRowCount = 0
ENDIF
IF VARTYPE(tnSideColCount) != 'N'
tnSideColCount = 0
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.xsplit WITH tnSideColCount, ;
xl_sheets.ysplit WITH tnTopRowCount IN xl_sheets
lxReturn = True
ELSE
lxReturn = False
ENDIF
RETURN lxReturn
ENDPROC
PROTECTED PROCEDURE getalphanumericsplit && Returns the position of the alpha and numeric split
LPARAMETERS tcText
LOCAL lnChr
FOR lnChr=1 TO LEN(tcText)
IF ISDIGIT(SUBSTR(tcText, lnChr, 1))
RETURN lnChr
ENDIF
ENDFOR
RETURN 0
ENDPROC
PROTECTED PROCEDURE getbordersrecord && Gets the border record; returns True if found, or False in not found
LPARAMETERS tnWB, tcLStyle, tnLColor, tcRStyle, tnRColor, tcTStyle, tnTColor, tcBStyle, tnBColor, tcDStyle, tnDColor, tnDiagDn, tnDiagUp
RETURN SEEK(BINTOC(tnWB) + tcLStyle + BINTOC(tnLColor) + tcRStyle + BINTOC(tnRColor) + tcTStyle + BINTOC(tnTColor) + tcBStyle + BINTOC(tnBColor) + ;
tcDStyle + BINTOC(tnDColor) + BINTOC(tnDiagDn) + BINTOC(tnDiagUp), "xl_borders", "cellborder")
ENDPROC
PROCEDURE getcellalignment && Returns the cell alignment
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL loAlignInfo
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
loAlignInfo = CREATEOBJECT("Empty")
ADDPROPERTY(loAlignInfo, "HorzAlign", xl_cellxfs.halign)
ADDPROPERTY(loAlignInfo, "VertAlign", xl_cellxfs.valign)
ELSE
loAlignInfo = .NULL.
ENDIF
RETURN loAlignInfo
ENDPROC
PROCEDURE getcellborders && Returns the cell border info
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL loBdrInfo
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs) .AND. this.GetCursorRecord("xl_borders", tnWB, xl_cellxfs.borderId)
loBdrInfo = CREATEOBJECT("Empty")
ADDPROPERTY(loBdrInfo, "LeftStyle", xl_borders.lstyle)
ADDPROPERTY(loBdrInfo, "LeftColor", xl_borders.lcolor)
ADDPROPERTY(loBdrInfo, "LeftTheme", xl_borders.ltheme)
ADDPROPERTY(loBdrInfo, "LeftTint", xl_borders.ltint)
ADDPROPERTY(loBdrInfo, "LeftIndex", xl_borders.lindexed)
ADDPROPERTY(loBdrInfo, "RightStyle", xl_borders.rstyle)
ADDPROPERTY(loBdrInfo, "RightColor", xl_borders.rcolor)
ADDPROPERTY(loBdrInfo, "RightTheme", xl_borders.rtheme)
ADDPROPERTY(loBdrInfo, "RightTint", xl_borders.rtint)
ADDPROPERTY(loBdrInfo, "RightIndex", xl_borders.rindexed)
ADDPROPERTY(loBdrInfo, "TopStyle", xl_borders.tstyle)
ADDPROPERTY(loBdrInfo, "TopColor", xl_borders.tcolor)
ADDPROPERTY(loBdrInfo, "TopTheme", xl_borders.ttheme)
ADDPROPERTY(loBdrInfo, "TopTint", xl_borders.ttint)
ADDPROPERTY(loBdrInfo, "TopIndex", xl_borders.tindexed)
ADDPROPERTY(loBdrInfo, "BotStyle", xl_borders.bstyle)
ADDPROPERTY(loBdrInfo, "BotColor", xl_borders.bcolor)
ADDPROPERTY(loBdrInfo, "BotTheme", xl_borders.btheme)
ADDPROPERTY(loBdrInfo, "BotTint", xl_borders.btint)
ADDPROPERTY(loBdrInfo, "BotIndex", xl_borders.bindexed)
ADDPROPERTY(loBdrInfo, "DiagStyle", xl_borders.dstyle)
ADDPROPERTY(loBdrInfo, "DiagColor", xl_borders.dcolor)
ADDPROPERTY(loBdrInfo, "DiagTheme", xl_borders.dtheme)
ADDPROPERTY(loBdrInfo, "DiagTint", xl_borders.dtint)
ADDPROPERTY(loBdrInfo, "DiagIndex", xl_borders.dindexed)
ADDPROPERTY(loBdrInfo, "DiagDn", xl_borders.diagdn)
ADDPROPERTY(loBdrInfo, "DiagUp", xl_borders.diagup)
ELSE
loBdrInfo = .NULL.
ENDIF
RETURN loBdrInfo
ENDPROC
PROCEDURE getcelldatatype && Returns the data type for the selected cell
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lxReturn
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
lxReturn = xl_cells.datatype
ELSE
lxReturn = .NULL.
ENDIF
RETURN lxReturn
ENDPROC
PROCEDURE getcellfill && Returns the fill info for the cell
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL loFillInfo
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs) .AND. this.GetCursorRecord("xl_fills", tnWB, xl_cellxfs.fillid)
loFillInfo = CREATEOBJECT("Empty")
ADDPROPERTY(loFillInfo, "FgColor", xl_fills.fgcolor)
ADDPROPERTY(loFillInfo, "BgColor", xl_fills.bgcolor)
ADDPROPERTY(loFillInfo, "PatType", xl_fills.patttype)
ADDPROPERTY(loFillInfo, "Theme", xl_fills.theme)
ADDPROPERTY(loFillInfo, "Tint", xl_fills.tint)
ADDPROPERTY(loFillInfo, "FgIndexed", xl_fills.fgindexed)
ADDPROPERTY(loFillInfo, "BgIndexed", xl_fills.bgindexed)
ELSE
loFillInfo = .NULL.
ENDIF
RETURN loFillInfo
ENDPROC
PROCEDURE getcellfont && Returns the cell font settings
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL loFontInfo
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs) .AND. this.GetCursorRecord("xl_fonts", tnWB, xl_cellxfs.fontid)
loFontInfo = CREATEOBJECT("Empty")
ADDPROPERTY(loFontInfo, "FontName", ALLTRIM(xl_fonts.fname))
ADDPROPERTY(loFontInfo, "FontSize", xl_fonts.fsize)
ADDPROPERTY(loFontInfo, "FontBold", xl_fonts.fbold)
ADDPROPERTY(loFontInfo, "FontItalic", xl_fonts.fitalic)
ADDPROPERTY(loFontInfo, "ForeColor", xl_fonts.fcolor)
ADDPROPERTY(loFontInfo, "FontUnderline", ALLTRIM(xl_fonts.uline))
ADDPROPERTY(loFontInfo, "FontStrikeThr", xl_fonts.strkthr)
ADDPROPERTY(loFontInfo, "FontVerticalPos", ALLTRIM(xl_fonts.fvpos))
ELSE
loFontInfo = .NULL.
ENDIF
RETURN loFontInfo
ENDPROC
PROCEDURE getcellformula && Returns the cell formula expression
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lcFormula
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
lcFormula = .NULL.
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
lcFormula = ALLTRIM(xl_cells.cellformula)
ENDIF
RETURN lcFormula
ENDPROC
PROTECTED PROCEDURE getcellformulafromxml && Gets the cell formula from the XML node
LPARAMETERS tcFormula, tnCellCol
LOCAL lcFormula, lcShared, lnId, lcTemp, lnNdx, lcChr, lcAddExpr, lnCol, lcRef, lcRefBeg, lcRefEnd, llColRelative
LOCAL lnColBase, llRowRelative, lnRowBase
lcFormula = this.GetNodeElementValue(tcFormula)
lcShared = this.GetNodeAttributeValue(tcFormula, "t")
IF !EMPTY(lcShared)
*-* The formula is a shared formula
lnId = this.GetNodeAttributeValue(tcFormula, "si")
IF EMPTY(lcFormula)
IF SEEK(lnId, "t_shared", "id")
*-* Shared formula already added; update the column:row relative references
lcFormula = ""
lcTemp = ALLTRIM(t_shared.cellformula)
DO CASE
CASE t_shared.colrelative && Forumla column is relative
lnNdx = 1
DO WHILE lnNdx <= LEN(lcTemp)
lcChr = SUBSTR(lcTemp, lnNdx, 1)
IF ISALPHA(lcChr)
lcAddExpr = lcChr
DO WHILE lnNdx <= LEN(lcTemp)
lnNdx = lnNdx + 1
lcChr = SUBSTR(lcTemp, lnNdx, 1)
DO CASE
CASE ISALPHA(lcChr)
lcAddExpr = lcAddExpr + lcChr
CASE ISDIGIT(lcChr)
lnCol = this.ColumnAsciiToIndex(lcAddExpr)
lnCol = lnCol + (tnCellCol - t_shared.colbase)
lcAddExpr = this.ColumnIndexToAscii(lnCol) + lcChr
EXIT
OTHERWISE
lcAddExpr = lcAddExpr + lcChr
EXIT
ENDCASE
ENDDO
ELSE
lcAddExpr = lcChr
ENDIF
lcFormula = lcFormula + lcAddExpr
lnNdx = lnNdx + 1
ENDDO
CASE t_shared.rowrelative && Forumla row is relative
lnNdx = 1
DO WHILE lnNdx <= LEN(lcTemp)
lcChr = SUBSTR(lcTemp, lnNdx, 1)
IF ISDIGIT(lcChr)
lcAddExpr = lcChr
DO WHILE lnNdx <= LEN(lcTemp)
lnNdx = lnNdx + 1
lcChr = SUBSTR(lcTemp, lnNdx, 1)
IF ISDIGIT(lcChr)
lcAddExpr = lcAddExpr + lcChr
ELSE
IF ISALPHA(lcChr)
lcAddExpr = lcAddExpr + lcChr
ELSE
lnRow = INT(VAL(lcAddExpr))
lnRow = lnRow + (lnCellRow - t_shared.rowbase)
lcAddExpr = TRANSFORM(lnRow) + lcChr
ENDIF
EXIT
ENDIF
ENDDO
ELSE
lcAddExpr = lcChr
ENDIF
lcFormula = lcFormula + lcAddExpr
lnNdx = lnNdx + 1
ENDDO
ENDCASE
ELSE
lcFormula = ""
ENDIF
ELSE
lcRef = this.GetNodeAttributeValue(tcFormula, "ref")
IF !SEEK(lnId, "t_shared", "id") .AND. OCCURS(":", lcRef) > 0
lcRefBeg = this.GetColumnInColRowPair(GETWORDNUM(lcRef, 1, ":"))
lcRefEnd = this.GetColumnInColRowPair(GETWORDNUM(lcRef, 2, ":"))
IF lcRefBeg == lcRefEnd
llColRelative = False
lnColBase = 0
llRowRelative = True
lnRowBase = this.GetRowInColRowPair(GETWORDNUM(lcRef, 1, ":"))
ELSE
llColRelative = True
lnColBase = this.ColumnAsciiToIndex(lcRefBeg)
llRowRelative = False
lnRowBase = 0
ENDIF
INSERT INTO t_shared (id, colrelative, colbase, rowrelative, rowbase, cellformula) ;
VALUES (lnId, llColRelative, lnColBase, llRowRelative, lnRowBase, lcFormula)
ENDIF
ENDIF
ENDIF
RETURN lcFormula
ENDPROC
PROCEDURE getcellindent && Returns the cell indentation
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lnIndent
IF PCOUNT() != 4
RETURN -1
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnIndent = xl_cellxfs.indent
ELSE
lnIndent = 0
ENDIF
RETURN lnIndent
ENDPROC
PROCEDURE getcellnumberformat && Returns the format code for the selected cell
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lnNumFmtId
IF PCOUNT() != 4
RETURN -1
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnNumFmtId = xl_cellxfs.numFmtId
ELSE
lnNumFmtId = 0
ENDIF
RETURN lnNumFmtId
ENDPROC
PROCEDURE getcellnumberformattext && Returns the selected cell numeric format as text
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lcFormatCode
IF PCOUNT() != 4
RETURN ""
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lcFormatCode = xl_cellxfs.formatcode
ELSE
lcFormatCode = ""
ENDIF
RETURN lcFormatCode
ENDPROC
PROTECTED PROCEDURE getcellrecord && Positions to the xl_cells record; returns true if found, or false if not found
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
RETURN SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnCellRow)+BINTOC(tnCellCol), "xl_cells", "cellindex")
ENDPROC
PROCEDURE getcellstyle && Gets the cell style value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
IF PCOUNT() = 4 .AND. this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
RETURN xl_cells.cellxfs
ELSE
RETURN -1
ENDIF
ENDPROC
PROCEDURE getcelltextrotation && Gets the cell text rotation value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lnRotation
IF PCOUNT() != 4
RETURN 99
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnRotation = xl_cellxfs.rotation
IF lnRotation > 90
lnRotation = 90 - lnRotation
ENDIF
ELSE
lnRotation = 0
ENDIF
RETURN lnRotation
ENDPROC
PROCEDURE getcellvalidation && Returns the cell validation settings
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL loValiation
loValiation = CREATEOBJECT("Empty")
ADDPROPERTY(loValiation, "Type", 0)
ADDPROPERTY(loValiation, "Style", 0)
ADDPROPERTY(loValiation, "Operator", 0)
ADDPROPERTY(loValiation, "AllowBlank", False)
ADDPROPERTY(loValiation, "ShowInputMsg", False)
ADDPROPERTY(loValiation, "ShowErrMsg", False)
ADDPROPERTY(loValiation, "ErrMsg", "")
ADDPROPERTY(loValiation, "ErrTitle", "")
ADDPROPERTY(loValiation, "Prompt", "")
ADDPROPERTY(loValiation, "Formula1", "")
ADDPROPERTY(loValiation, "Formula2", "")
IF PCOUNT() < 4
RETURN loValiation
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. SEEK(BINTOC(xl_cells.validndx), "xl_validation", "validndx")
loValiation.Type = xl_validation.vtype
loValiation.Style = xl_validation.vstyle
loValiation.Operator = xl_validation.voperator
loValiation.AllowBlank = xl_validation.allowblank
loValiation.ShowInputMsg = xl_validation.showinpmsg
loValiation.ShowErrMsg = xl_validation.showerrmsg
loValiation.ErrMsg = xl_validation.errmsg
loValiation.ErrTitle = xl_validation.errtitle
loValiation.Prompt = xl_validation.vprompt
loValiation.Formula1 = xl_validation.formula1
loValiation.Formula2 = xl_validation.formula2
ENDIF
RETURN loValiation
ENDPROC
PROCEDURE getcellvalue && Returns the value of the cell
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lxValue, lnDays, lnDecimals, lnMSec, lnTime, lnSize, lcType, loException
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
lxValue = .NULL.
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
lnDecimals = SET("DECIMALS")
TRY
DO CASE
CASE xl_cells.datatype = DATA_TYPE_DATE
lnDays = CAST(xl_cells.cellvalue AS I)
lxValue = DATE(1900, 1, 1) + lnDays - 2
CASE xl_cells.datatype = DATA_TYPE_TIME
SET DECIMALS TO 12
lnMSec = CAST(xl_cells.cellvalue AS N(20,12))
lnTime = lnMSec * 24 * 60 * 60
lxValue = DTOT(DATE()) + lnTime
lxValue = TRANSFORM(HOUR(lxValue)) + ":" + TRANSFORM(MINUTE(lxValue)) + ":" + TRANSFORM(SEC(lxValue))
CASE xl_cells.datatype = DATA_TYPE_DATETIME
SET DECIMALS TO 12
lnDays = CAST(xl_cells.cellvalue AS I)
lxValue = DATE(1900, 1, 1) + lnDays - 2
lnMSec = CAST(xl_cells.cellvalue AS N(20,12)) - lnDays
lnTime = lnMSec * 24 * 60 * 60
lxValue = DTOT(lxValue) + lnTime
CASE xl_cells.datatype = DATA_TYPE_CHAR
IF this.GetCursorRecord("xl_strings", tnWB, xl_cells.stringid)
lxValue = RTRIM(xl_strings.stringval)
ELSE
lxValue = ""
ENDIF
CASE xl_cells.datatype = DATA_TYPE_INT
lxValue = CAST(xl_cells.cellvalue AS I)
IF lxValue != VAL(xl_cells.cellvalue) && Fix suggestion by Dan Lauer for integer values larger than VFP max
lxValue = CAST(xl_cells.cellvalue AS N(20,0))
ENDIF
CASE xl_cells.datatype = DATA_TYPE_FLOAT
lnSize = ATC(".", ALLTRIM(xl_cells.cellvalue))
IF lnSize > 0
lnSize = lnSize + lnDecimals
ELSE
lnSize = LEN(ALLTRIM(xl_cells.cellvalue)) + lnDecimals + 1
ENDIF
lcType = "N(" + TRANSFORM(lnSize) + "," + TRANSFORM(lnDecimals) + ")"
lxValue = CAST(xl_cells.cellvalue AS &lcType)
CASE xl_cells.datatype = DATA_TYPE_CURRENCY
lxValue = CAST(xl_cells.cellvalue AS Y)
CASE xl_cells.datatype = DATA_TYPE_PERCENT
lxValue = CAST(xl_cells.cellvalue AS N(14,8))
lxValue = TRANSFORM(lxValue * 100) + "%"
CASE xl_cells.datatype = DATA_TYPE_GENERAL
lxValue = ALLTRIM(xl_cells.cellvalue)
CASE xl_cells.datatype = DATA_TYPE_FORMULA
CASE xl_cells.datatype = DATA_TYPE_NONE
lxValue = ALLTRIM(xl_cells.cellvalue)
OTHERWISE
lxValue = ALLTRIM(xl_cells.cellvalue)
ENDCASE
CATCH TO loException
SET STEP ON
FINALLY
SET DECIMALS TO &lnDecimals
ENDTRY
ENDIF
RETURN lxValue
ENDPROC
PROCEDURE getcellwordwrap && Returns the cell word wrap setting
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL lxReturn
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lxReturn = xl_cellxfs.wraptext
ELSE
lxReturn = .NULL.
ENDIF
RETURN lxReturn
ENDPROC
PROTECTED PROCEDURE getcellxfsid && Returns the Cell XfsId value
LPARAMETERS tnWB, tnNumFmtId, tnFontId, tnFillId, tnBorderId, tcHAlign, tcVAlign, tnIndex, tnWrapText, tnRotation
LOCAL lnCellXfsId
IF SEEK(BINTOC(tnWB)+BINTOC(tnNumFmtId)+BINTOC(tnFontId)+BINTOC(tnFillId)+BINTOC(tnBorderId)+BINTOC(tnIndex)+BINTOC(tnWrapText)+BINTOC(tnRotation)+ALLTRIM(tcHAlign)+ALLTRIM(tcVAlign), "xl_cellxfs", "cellxfs")
lnCellXfsId = xl_cellxfs.id
ELSE
lnCellXfsId = this.GetNextId(tnWB, 'xl_cellxfs')
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, rotation) ;
VALUES (tnWB, lnCellXfsId, tnNumFmtId, tnFontId, tnFillId, tnBorderId, tcHAlign, tcVAlign, tnIndex, tnWrapText, tnRotation)
ENDIF
RETURN lnCellXfsId
ENDPROC
PROTECTED PROCEDURE getcellxfsrecord && Positions the record pointer to xl_cellxfs record; returns true if found, or false if not found
LPARAMETERS tnWB, tnId
RETURN SEEK(BINTOC(tnWB)+BINTOC(tnId), "xl_cellxfs", "id")
ENDPROC
PROTECTED PROCEDURE getchecksum && Returns the checksum the string
LPARAMETERS tcString
LOCAL lcString, lcCheckSum
lcString = ALLTRIM(tcString)
lcCheckSum = SYS(2007, lcString, 0, 1)
lcCheckSum = lcCheckSum + PADR(lcString, (230-LEN(lcCheckSum)), "_")
RETURN lcCheckSum
ENDPROC
PROTECTED PROCEDURE getchildnodecount && Returns the number of child nodes
LPARAMETERS tcNode
RETURN OCCURS("<", tcNode) - 2
ENDPROC
PROTECTED PROCEDURE getchildnodeelement && Returns the selected child node
LPARAMETERS tcNode, tnChild
LOCAL lcElement
lcElement = STREXTRACT(tcNode, '<', '>', tnChild+1, 1)
RETURN STREXTRACT(tcNode, '<'+lcElement+'>', '</'+lcElement+'>', 1, 5)
ENDPROC
PROTECTED PROCEDURE getcolumnincolrowpair && Returns the column (Ascii value) in a ColRow pair; i.e., returns A from A6 reference
LPARAMETERS tcColRow
LOCAL lnNdx, lcCol, lcChr
lcCol = ""
FOR lnNdx=1 TO LEN(tcColRow)
lcChr = SUBSTR(tcColRow, lnNdx, 1)
IF ISDIGIT(lcChr)
EXIT
ENDIF
lcCol = lcCol + lcChr
ENDFOR
RETURN lcCol
ENDPROC
PROCEDURE getcolumnwidth && Returns the column width
LPARAMETERS tnWB, tnSheet, tnColumn
LOCAL lxReturn
IF PCOUNT() < 3
RETURN .NULL.
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetColWidthKeyExpr(tnWB, tnSheet, tnColumn), "xl_colwidths", "shcolumn")
lxReturn = xl_colwidths.width
ELSE
lxReturn = -1
ENDIF
ELSE
lxReturn = .NULL.
ENDIF
RETURN lxReturn
ENDPROC
PROTECTED PROCEDURE getcolwidthkeyexpr && Gets the key expression for c_colwidths
LPARAMETERS tnWB, tnSheet, tnColumn
RETURN BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnColumn)
ENDPROC
PROTECTED PROCEDURE getcursorrecord && Gets the specified xl_cursor record; returns true if found, false if not found
LPARAMETERS tcCursor, tnWB, tnId
RETURN SEEK(BINTOC(tnWB)+BINTOC(tnId), tcCursor, "id")
ENDPROC
PROCEDURE getcustomnumericformat && Returns the format code for the specified custom numeric format
LPARAMETERS tnWB, tnNumFormat
LOCAL lxReturn
IF SEEK(BINTOC(tnWB)+BINTOC(tnNumFormat), "xl_numfmts", "id")
lxReturn = ALLTRIM(xl_numfmts.formatcode)
ELSE
lxReturn = ""
ENDIF
RETURN lxReturn
ENDPROC
PROCEDURE getcustompapersize && Gets the values for the custom paper size
LPARAMETERS tnWB, tnSheet
LOCAL loReturn
IF PCOUNT() = 2 .AND. this.GetSheetRecord(tnWB, tnSheet)
loReturn = CREATEOBJECT("Empty")
ADDPROPERTY(loReturn, "PaperWidth", xl_sheets.paperwidth)
ADDPROPERTY(loReturn, "PaperHeight", xl_sheets.paperheight)
ADDPROPERTY(loReturn, "PaperDimen", xl_sheets.paperdimen)
ELSE
loReturn = .NULL.
ENDIF
RETURN loReturn
ENDPROC
PROTECTED PROCEDURE getformatkeyexpr && Gets the key expression for t_format
LPARAMETERS tnNbrFmtId, tnNumDec, tnFontId, tnFillId, tnBorderId, tcHAlign, tcVAlign, tlWordWrap
RETURN BINTOC(tnNbrFmtId)+BINTOC(tnNumDec)+BINTOC(tnFontId)+BINTOC(tnFillId)+BINTOC(tnBorderId)+tcHAlign+tcVAlign+TRANSFORM(tlWordWrap)
ENDPROC
PROTECTED PROCEDURE getheaderfooterkeyexpr && Gets the key expression for the header footer table record
LPARAMETERS tnWB, tnSheet, tnPage, tnSection
RETURN BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnPage)+BINTOC(tnSection)
ENDPROC
PROCEDURE getinlinefontdefinition && Returns the inline formatting definition of cell text for each character group
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL loSharedString, loInline, lcAlias, lnBegPos, lnLen, loCharacter
IF PCOUNT() != 4
RETURN .NULL.
ENDIF
loSharedString = this.GetSharedStringId(tnWB, tnSheet, tnCellRow, tnCellCol)
IF ISNULL(loSharedString)
RETURN .NULL.
ENDIF
lnBegPos = 1
lcAlias = ALIAS()
loInline = CREATEOBJECT("Empty")
ADDPROPERTY(loInline, "Workbook", tnWB)
ADDPROPERTY(loInline, "StringId", loSharedString.StringId)
ADDPROPERTY(loInline, "StringValue", loSharedString.StringValue)
ADDPROPERTY(loInline, "Count", 0)
ADDPROPERTY(loInline, "Characters[1]")
SELECT xl_strformat
SET ORDER TO TAG sortorder
SCAN FOR workbook = tnWB .AND. id = loSharedString.StringId .AND. !DELETED()
lnLen = LEN(RTRIM(xl_strformat.stringxml))
loCharacter = CREATEOBJECT("Empty")
ADDPROPERTY(loCharacter, "BegPos", lnBegPos)
ADDPROPERTY(loCharacter, "Length", lnLen)
ADDPROPERTY(loCharacter, "FontName", xl_strformat.fname)
ADDPROPERTY(loCharacter, "FontSize", xl_strformat.fsize)
ADDPROPERTY(loCharacter, "FontBold", xl_strformat.fbold)
ADDPROPERTY(loCharacter, "FontItalic", xl_strformat.fitalic)
ADDPROPERTY(loCharacter, "FontColor", xl_strformat.fcolor)
ADDPROPERTY(loCharacter, "Underline", xl_strformat.uline)
ADDPROPERTY(loCharacter, "StrikeThru", xl_strformat.strkthr)
ADDPROPERTY(loCharacter, "SubScript", IIF(xl_strformat.fvpos=FONT_VERTICAL_SUBSCRIPT, True, False))
ADDPROPERTY(loCharacter, "SuperScript", IIF(xl_strformat.fvpos=FONT_VERTICAL_SUPERSCRIPT, True, False))
loInline.Count = loInline.Count + 1
DIMENSION loInline.Characters[loInline.Count]
loInline.Characters[loInline.Count] = loCharacter
lnBegPos = lnBegPos + lnLen
ENDSCAN
SET ORDER TO
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
IF loInline.Count = 0
loInline = .NULL.
ENDIF
RETURN loInline
ENDPROC
PROCEDURE getlastcolumninrow && Returns the last column index in the row
LPARAMETERS tnWB, tnSheet, tnCellRow
LOCAL lnMaxCol
IF PCOUNT() < 3
RETURN .NULL.
ENDIF
lnMaxCol = 0
SELECT MAX(tmp.cellcol) AS maxcol FROM xl_cells AS tmp ;
WHERE workbook = tnWB ;
AND tmp.sheet = tnSheet ;
AND tmp.cellrow = tnCellRow ;
AND tmp.celldeleted = False ;
INTO CURSOR t_temp
IF _TALLY > 0
lnMaxCol = t_temp.maxcol
ENDIF
IF USED('t_temp')
USE IN t_temp
ENDIF
RETURN lnMaxCol
ENDPROC
PROCEDURE getlastrownumber && Returns the last row number in the sheet
LPARAMETERS tnWB, tnSheet
LOCAL lnLastRow
LOCAL ARRAY laMaxRow[1]
IF PCOUNT() < 2
RETURN .NULL.
ENDIF
SELECT MAX(cellrow) FROM xl_cells ;
WHERE workbook = tnWB ;
AND sheet = tnSheet ;
AND celldeleted = False ;
INTO ARRAY laMaxRow
IF _TALLY > 0
lnLastRow = laMaxRow[1]
ELSE
lnLastRow = 0
ENDIF
RETURN lnLastRow
ENDPROC
PROCEDURE getmaxcolumnnumber && Returns the max column number for a sheet
LPARAMETERS tnWB, tnSheet
LOCAL lnMaxCol
LOCAL ARRAY laMaxCol[1]
IF PCOUNT() < 2
RETURN .NULL.
ENDIF
SELECT MAX(tmp.maxcol) AS maxcol FROM xl_rows AS tmp ;
WHERE tmp.workbook = tnWB ;
AND tmp.sheet = tnSheet ;
INTO ARRAY laMaxCol
IF _TALLY > 0
lnMaxCol = laMaxCol[1]
ELSE
lnMaxCol = 0
ENDIF
RETURN NVL(lnMaxCol, 0)
ENDPROC
PROTECTED PROCEDURE getnextid && Gets the next sequential Id value
LPARAMETERS tnWB, tcCursor
LOCAL lnNdx, lnNextId
DO CASE
CASE tcCursor = "xl_borders"
lnNdx = ASCAN(this.LastBorderId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastBorderId[lnNdx, 2] = this.LastBorderId[lnNdx, 2] + 1
lnNextId = this.LastBorderId[lnNdx, 2]
ELSE
IF this.LastBorderId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastBorderId, 1) + 1
ENDIF
DIMENSION this.LastBorderId[lnNdx, 2]
this.LastBorderId[lnNdx, 1] = tnWB
this.LastBorderId[lnNdx, 2] = 1
lnNextId = 1
ENDIF
CASE tcCursor = "xl_cellxfs"
lnNdx = ASCAN(this.LastCellXfsId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastCellXfsId[lnNdx, 2] = this.LastCellXfsId[lnNdx, 2] + 1
lnNextId = this.LastCellXfsId[lnNdx, 2]
ELSE
IF this.LastCellXfsId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastCellXfsId, 1) + 1
ENDIF
DIMENSION this.LastCellXfsId[lnNdx, 2]
this.LastCellXfsId[lnNdx, 1] = tnWB
this.LastCellXfsId[lnNdx, 2] = 1
lnNextId = 1
ENDIF
CASE tcCursor = "xl_fills"
lnNdx = ASCAN(this.LastFillId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastFillId[lnNdx, 2] = this.LastFillId[lnNdx, 2] + 1
lnNextId = this.LastFillId[lnNdx, 2]
ELSE
IF this.LastFillId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastFillId, 1) + 1
ENDIF
DIMENSION this.LastFillId[lnNdx, 2]
this.LastFillId[lnNdx, 1] = tnWB
this.LastFillId[lnNdx, 2] = 2
lnNextId = 2
ENDIF
CASE tcCursor = "xl_fonts"
lnNdx = ASCAN(this.LastFontId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastFontId[lnNdx, 2] = this.LastFontId[lnNdx, 2] + 1
lnNextId = this.LastFontId[lnNdx, 2]
ELSE
IF this.LastFontId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastFontId, 1) + 1
ENDIF
DIMENSION this.LastFontId[lnNdx, 2]
this.LastFontId[lnNdx, 1] = tnWB
this.LastFontId[lnNdx, 2] = 1
lnNextId = 1
ENDIF
CASE tcCursor = "xl_ndxcolors"
lnNdx = ASCAN(this.LastIndexColorId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastIndexColorId[lnNdx, 2] = this.LastIndexColorId[lnNdx, 2] + 1
lnNextId = this.LastIndexColorId[lnNdx, 2]
ELSE
IF this.LastIndexColorId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastIndexColorId, 1) + 1
ENDIF
DIMENSION this.LastIndexColorId[lnNdx, 2]
this.LastIndexColorId[lnNdx, 1] = tnWB
this.LastIndexColorId[lnNdx, 2] = 1
lnNextId = 1
ENDIF
CASE tcCursor = "xl_mrucolors"
lnNdx = ASCAN(this.LastMruColorId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastMruColorId[lnNdx, 2] = this.LastMruColorId[lnNdx, 2] + 1
lnNextId = this.LastMruColorId[lnNdx, 2]
ELSE
IF this.LastMruColorId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastMruColorId, 1) + 1
ENDIF
DIMENSION this.LastMruColorId[lnNdx, 2]
this.LastMruColorId[lnNdx, 1] = tnWB
this.LastMruColorId[lnNdx, 2] = 1
lnNextId = 1
ENDIF
CASE tcCursor = "xl_numfmts"
lnNdx = ASCAN(this.LastNumFmtId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastNumFmtId[lnNdx, 2] = this.LastNumFmtId[lnNdx, 2] + 1
lnNextId = this.LastNumFmtId[lnNdx, 2]
ELSE
IF this.LastNumFmtId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastNumFmtId, 1) + 1
ENDIF
DIMENSION this.LastNumFmtId[lnNdx, 2]
this.LastNumFmtId[lnNdx, 1] = tnWB
this.LastNumFmtId[lnNdx, 2] = START_NUMERIC_FORMAT_ID
lnNextId = START_NUMERIC_FORMAT_ID
ENDIF
CASE tcCursor = "xl_relationships"
lnNdx = ASCAN(this.LastRelationId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastRelationId[lnNdx, 2] = this.LastRelationId[lnNdx, 2] + 1
lnNextId = this.LastRelationId[lnNdx, 2]
ELSE
IF this.LastRelationId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastRelationId, 1) + 1
ENDIF
DIMENSION this.LastRelationId[lnNdx, 2]
this.LastRelationId[lnNdx, 1] = tnWB
this.LastRelationId[lnNdx, 2] = 1
lnNextId = 1
ENDIF
CASE tcCursor = "xl_sheets"
lnNdx = ASCAN(this.LastSheetId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastSheetId[lnNdx, 2] = this.LastSheetId[lnNdx, 2] + 1
lnNextId = this.LastSheetId[lnNdx, 2]
ELSE
IF this.LastSheetId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastSheetId, 1) + 1
ENDIF
DIMENSION this.LastSheetId[lnNdx, 2]
this.LastSheetId[lnNdx, 1] = tnWB
this.LastSheetId[lnNdx, 2] = 1
lnNextId = 1
ENDIF
CASE tcCursor = "xl_strings"
lnNdx = ASCAN(this.LastStringId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastStringId[lnNdx, 2] = this.LastStringId[lnNdx, 2] + 1
lnNextId = this.LastStringId[lnNdx, 2]
ELSE
IF this.LastStringId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastStringId, 1) + 1
ENDIF
DIMENSION this.LastStringId[lnNdx, 2]
this.LastStringId[lnNdx, 1] = tnWB
this.LastStringId[lnNdx, 2] = 0
lnNextId = 0
ENDIF
OTHERWISE
lnNextId = 0
ENDCASE
RETURN lnNextId
ENDPROC
PROTECTED PROCEDURE getnodeattributevalue && Returns the attribute value
LPARAMETERS tcXf, tcAttrName
RETURN STREXTRACT(tcXf, tcAttrName+'="', '"', 1)
ENDPROC
PROTECTED PROCEDURE getnodecount && Returns the number of nodes to be processed
LPARAMETERS tcNode, tcElement
LOCAL lnCount
lnCount = OCCURS("<"+tcElement+">", tcNode)
IF lnCount = 0
lnCount = OCCURS("<"+tcElement+" ", tcNode)
IF lnCount = 0
lnCount = OCCURS("<"+tcElement, tcNode)
ENDIF
ENDIF
RETURN lnCount
ENDPROC
PROTECTED PROCEDURE getnodeelement && Gets the string content for the node element
LPARAMETERS tcNode, tcElement, tnNode, tlStrict, tnFlag
LOCAL lcContent, lnNdx, loException
DO CASE
CASE PCOUNT() = 3
tlStrict = False
tnFlag = 5
CASE PCOUNT() = 4
tnFlag = 5
ENDCASE
IF tlStrict
lcContent = STREXTRACT(tcNode, "<"+tcElement+">", "</"+tcElement+">", tnNode, tnFlag)
ELSE
lcContent = STREXTRACT(tcNode, "<"+tcElement+" ", ">", tnNode, tnFlag)
IF RIGHT(lcContent, 2) != "/>"
lcContent = STREXTRACT(tcNode, "<"+tcElement+" ", "</"+tcElement+">", tnNode, tnFlag)
IF EMPTY(lcContent)
lcContent = STREXTRACT(tcNode, "<"+tcElement+">", "</"+tcElement+">", tnNode, tnFlag)
ENDIF
IF EMPTY(lcContent)
lcContent = STREXTRACT(tcNode, "<"+tcElement, "/>", tnNode, tnFlag)
ENDIF
ENDIF
ENDIF
RETURN lcContent
ENDPROC
PROTECTED PROCEDURE getnodeelementvalue && Gets the value assigned to the node element
LPARAMETERS tcElement
RETURN STREXTRACT(tcElement, '>', '<', 1, 1)
ENDPROC
PROCEDURE getnumberofsheets && Returns the number of sheets for the given workbook
LPARAMETERS tnWB
LOCAL lnCount
SELECT xl_sheets
COUNT FOR xl_sheets.workbook = tnWB .AND. !xl_sheets.shdeleted TO lnCount
RETURN lnCount
ENDPROC
PROCEDURE getpapersize && Gets the paper size for the selected sheet
LPARAMETERS tnWB, tnSheet
LOCAL lxReturn
IF PCOUNT() = 2 .AND. this.GetSheetRecord(tnWB, tnSheet)
lxReturn = xl_sheets.papersize
ELSE
lxReturn = -1
ENDIF
RETURN lxReturn
ENDPROC
PROCEDURE getprintorientation && Gets the print orientation for the sheet output
LPARAMETERS tnWB, tnSheet
LOCAL lxReturn
IF PCOUNT() = 2 .AND. this.GetSheetRecord(tnWB, tnSheet)
lxReturn = xl_sheets.prnorient
ELSE
lxReturn = 0
ENDIF
RETURN lxReturn
ENDPROC
PROTECTED PROCEDURE getrelationshipfilename && Gets the file name for the R:Id value in the relationships XML
LPARAMETERS tnWB, tnShRId
LOCAL lcFileName
lcFileName = ""
IF SEEK(BINTOC(tnWB)+BINTOC(tnShRId), "xl_relationships", "relid")
lcFileName = ALLTRIM(xl_relationships.target)
ENDIF
RETURN lcFileName
ENDPROC
PROCEDURE getrgbvalues && Gets the specified RGB color value
LPARAMETERS tnColorValue, tcRGB
LOCAL lnValue, lnNdx
IF PCOUNT() < 2
RETURN -1
ENDIF
DO CASE
CASE tcRGB = "R"
lnValue = tnColorValue
FOR lnNdx=8 TO 31
lnValue = BITCLEAR(lnValue, lnNdx)
ENDFOR
CASE tcRGB = "G"
lnValue = BITRSHIFT(tnColorValue, 8)
FOR lnNdx=8 TO 31
lnValue = BITCLEAR(lnValue, lnNdx)
ENDFOR
CASE tcRGB = "B"
lnValue = BITRSHIFT(tnColorValue, 16)
FOR lnNdx=8 TO 31
lnValue = BITCLEAR(lnValue, lnNdx)
ENDFOR
OTHERWISE
RETURN -1
ENDCASE
RETURN INT(lnValue)
ENDPROC
PROTECTED PROCEDURE getrowheightkeyexpr && Gets the key expression for the c_rowheights
LPARAMETERS tnWB, tnSheet, tnRow
RETURN BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnRow)
ENDPROC
PROTECTED PROCEDURE getrowincolrowpair && REturns the row (integer value) in a ColRow pair; i.e., return 6 from A6 reference
LPARAMETERS tcColRow
LOCAL lcRow, lnNdx, lcChr
lcRow = ""
FOR lnNdx=1 TO LEN(tcColRow)
lcChr = SUBSTR(tcColRow, lnNdx, 1)
IF ISDIGIT(lcChr)
lcRow = lcRow + lcChr
ENDIF
ENDFOR
RETURN INT(VAL(lcRow))
ENDPROC
PROCEDURE getrowmaxcolumn && Returns the selected row maximum column
LPARAMETERS tnWB, tnSheet, tnCellRow
LOCAL lnMaxCol
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnCellRow), "xl_rows", "id")
lnMaxCol = xl_rows.maxcol
ELSE
lnMaxCol = 0
ENDIF
RETURN lnMaxCol
ENDPROC
PROTECTED PROCEDURE getsharedstringid && Gets the Shared Strings Id value for the cell text
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL loSharedString
loSharedString = .NULL.
IF PCOUNT() < 4
RETURN loSharedString
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol) .AND. this.GetCursorRecord("xl_strings", tnWB, xl_cells.stringid)
loSharedString = CREATEOBJECT("Empty")
ADDPROPERTY(loSharedString, "StringId", xl_cells.stringid)
ADDPROPERTY(loSharedString, "StringValue", xl_strings.stringval)
ENDIF
RETURN loSharedString
ENDPROC
PROCEDURE getsheetname && Gets the sheet name
LPARAMETERS tnWB, tnSheet
LOCAL lcSheetName
IF PCOUNT() = 2 .AND. this.GetSheetRecord(tnWB, tnSheet)
lcSheetName = ALLTRIM(xl_sheets.shname)
ELSE
lcSheetName = ""
ENDIF
RETURN lcSheetName
ENDPROC
PROTECTED PROCEDURE getsheetrecord && Positions the record in xl_sheets; returns true if record found, or false if not found
LPARAMETERS tnWB, tnSheet
RETURN SEEK(BINTOC(tnWB)+BINTOC(tnSheet), "xl_sheets", "sheetndx")
ENDPROC
PROCEDURE getsheetrowvalues && Returns the cell values for the given row
LPARAMETERS tnWB, tnSheet, tnCellRow
LOCAL lnMaxCol, loRow
IF PCOUNT() < 3
RETURN .NULL.
ENDIF
lnMaxCol = this.GetMaxColumnNumber(tnWB, tnSheet)
IF !ISNULL(lnMaxCol) .AND. lnMaxCol > 0
loRow = CREATEOBJECT("Empty")
ADDPROPERTY(loRow, "Values[lnMaxCol, 2]", "")
ADDPROPERTY(loRow, "Count", lnMaxCol)
loRow.Values = .NULL.
SELECT tmp.cellcol FROM xl_cells AS tmp ;
WHERE workbook = tnWB ;
AND tmp.sheet = tnSheet ;
AND tmp.cellrow = tnCellRow ;
AND tmp.celldeleted = False ;
INTO CURSOR t_temp
SELECT t_temp
SCAN
loRow.Values[t_temp.cellcol, 1] = this.GetCellValue(tnWB, tnSheet, tnCellRow, t_temp.cellcol)
loRow.Values[t_temp.cellcol, 2] = this.GetCellDataType(tnWB, tnSheet, tnCellRow, t_temp.cellcol)
ENDSCAN
USE IN t_temp
ELSE
loRow = .NULL.
ENDIF
RETURN loRow
ENDPROC
PROCEDURE getsheetscale && Gets the sheet printing scale
LPARAMETERS tnWB, tnSheet
LOCAL lxReturn
IF PCOUNT() = 2 .AND. this.GetSheetRecord(tnWB, tnSheet)
lxReturn = xl_sheets.scale
ELSE
lxReturn = -1
ENDIF
RETURN lxReturn
ENDPROC
PROTECTED PROCEDURE getstringrecord && Positions the record pointer to the selected string record
LPARAMETERS tnWB, tcString
RETURN SEEK(BINTOC(tnWB)+this.GetCheckSum(tcString), "xl_strings", "stringndx")
ENDPROC
PROTECTED PROCEDURE getstringxml && Returns a converted string from XML to text
LPARAMETERS tcString
LOCAL lcString, lcOldChr, lcChr, lnChr, lnNdx
IF LEFT(tcString, 1) != " " .AND. EMPTY(tcString)
RETURN ""
ENDIF
TRY
IF ISNULL(this.oXDOM)
lcString = STRTRAN(tcString, '&amp;', CHR(38))
lcString = STRTRAN(lcString, '&gt;', '>')
lcString = STRTRAN(lcString, '&lt;', '<')
lcString = STRTRAN(lcString, '&quot;', '"')
lnNdx = 1
DO WHILE ATC("&#", lcString, lnNdx) > 0
lcOldChr = STREXTRACT(lcString, "&#", ";", lnNdx)
lnChr = INT(VAL(lcOldChr))
IF lnChr < 256
lcChr = CHR(lnChr)
lcOldChr = "&#" + lcOldChr + ";"
lcString = STRTRAN(lcString, lcOldChr, lcChr)
ELSE
lnNdx = lnNdx + 1 && Increment to skip this embedded value
ENDIF
ENDDO
ELSE
this.oXDOM.loadXML("<value>" + tcString + "</value>")
lcString = this.oXDOM.Text
ENDIF
CATCH TO loException
SET STEP ON
ENDTRY
RETURN lcString
ENDPROC
PROCEDURE getvalidation && Returns the validation definition
LPARAMETERS tnValidNdx
LOCAL loValiation
loValiation = CREATEOBJECT("Empty")
ADDPROPERTY(loValiation, "Type", 0)
ADDPROPERTY(loValiation, "Style", 0)
ADDPROPERTY(loValiation, "Operator", 0)
ADDPROPERTY(loValiation, "AllowBlank", False)
ADDPROPERTY(loValiation, "ShowInputMsg", False)
ADDPROPERTY(loValiation, "ShowErrMsg", False)
ADDPROPERTY(loValiation, "ErrMsg", "")
ADDPROPERTY(loValiation, "ErrTitle", "")
ADDPROPERTY(loValiation, "Prompt", "")
ADDPROPERTY(loValiation, "Formula1", "")
ADDPROPERTY(loValiation, "Formula2", "")
IF PCOUNT() < 1
RETURN loValiation
ENDIF
IF SEEK(BINTOC(tnValidNdx), "xl_validation", "validndx")
loValiation.Type = xl_validation.vtype
loValiation.Style = xl_validation.vstyle
loValiation.Operator = xl_validation.voperator
loValiation.AllowBlank = xl_validation.allowblank
loValiation.ShowInputMsg = xl_validation.showinpmsg
loValiation.ShowErrMsg = xl_validation.showerrmsg
loValiation.ErrMsg = xl_validation.errmsg
loValiation.ErrTitle = xl_validation.errtitle
loValiation.Prompt = xl_validation.vprompt
loValiation.Formula1 = IIF(xl_validation.formula, "=", "") + ALLTRIM(xl_validation.formula1)
loValiation.Formula2 = IIF(EMPTY(xl_validation.formula2), "", IIF(xl_validation.formula, "=", "") + ALLTRIM(xl_validation.formula2))
ENDIF
RETURN loValiation
ENDPROC
PROCEDURE getvalidationlist && Returns a list of validations for the workbook/sheet
LPARAMETERS tnWB, tnSheet
LOCAL loValiation, lcAlias
lcAlias = ALIAS()
loValiation = CREATEOBJECT("Empty")
ADDPROPERTY(loValiation, "List[1]")
ADDPROPERTY(loValiation, "Count", 0)
SELECT xl_validation
SCAN FOR BINTOC(workbook)+BINTOC(sheet)
loValiation.Count = loValiation.Count + 1
DIMENSION loValiation.List[loValiation.Count, 2]
loValiation.List[loValiation.Count, 1] = xl_validation.vtype
loValiation.List[loValiation.Count, 2] = xl_validation.validndx
ENDSCAN
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN loValiation
ENDPROC
PROCEDURE getworkbook && Gets the workbook Id from the name
LPARAMETERS tcName
LOCAL lcWBName, lnWBIndex
lcWBName = JUSTSTEM(tcName)
IF SEEK(PADR(UPPER(lcWBName), 200, "_"), "xl_workbooks", "wbname")
lnWBIndex = xl_workbooks.workbook
ELSE
lnWBIndex = 0
ENDIF
RETURN lnWBIndex
ENDPROC
PROCEDURE getworkbookfilename && Gets the file name for the workbook index
LPARAMETERS tnWB
LOCAL lcFileName
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
lcFileName = ADDBS(ALLTRIM(xl_workbooks.filepath)) + ALLTRIM(xl_workbooks.wbname)
lcFileName = FORCEEXT(lcFileName, "xlsx")
ELSE
lcFileName = ""
ENDIF
ENDPROC
PROCEDURE getworkbooksheets && Returns the workbook sheets
LPARAMETERS tnWB
LOCAL loSheets
loSheets = CREATEOBJECT("Empty")
ADDPROPERTY(loSheets, "List[1, 2]")
ADDPROPERTY(loSheets, "Count", 0)
SELECT xl_sheets
SET ORDER TO TAG sheet
SCAN FOR workbook = tnWB .AND. !shdeleted
loSheets.Count = loSheets.Count + 1
DIMENSION loSheets.List[loSheets.Count, 2]
loSheets.List[loSheets.Count, 1] = xl_sheets.sheet
loSheets.List[loSheets.Count, 2] = ALLTRIM(xl_sheets.shname)
ENDSCAN
SET ORDER TO
RETURN loSheets
ENDPROC
PROTECTED PROCEDURE getxmlheaderfootertext && Returns a XML formatted string for the header and footer text
LOCAL lcText
IF EMPTY(xl_hdrfootertext.fontname)
lcText = '"-,'
ELSE
lcText = '"' + ALLTRIM(xl_hdrfootertext.fontname) + ','
ENDIF
DO CASE
CASE xl_hdrfootertext.fontstyle = HEADERFOOTER_FONT_STYLE_BOLD
lcText = lcText + 'Bold"'
CASE xl_hdrfootertext.fontstyle = HEADERFOOTER_FONT_STYLE_ITALIC
lcText = lcText + 'Italic"'
CASE xl_hdrfootertext.fontstyle = HEADERFOOTER_FONT_STYLE_BOLDITALIC
lcText = lcText + 'Bold Italic"'
OTHERWISE
lcText = lcText + 'Regular"'
ENDCASE
IF xl_hdrfootertext.fontsize > 0
lcText = lcText + '&amp;' + TRANSFORM(xl_hdrfootertext.fontsize)
ENDIF
IF xl_hdrfootertext.fontcolor > 0
lcText = lcText + '&amp;K' + this.ConvertColorToHex(xl_hdrfootertext.fontcolor)
ENDIF
lcText = lcText + ALLTRIM(xl_hdrfootertext.text)
RETURN lcText
ENDPROC
PROTECTED PROCEDURE getxmlstring && Gets the string as an XML formatted string
LPARAMETERS tcString
LOCAL lcString, lcXMLString, lnNdx, lcChar, lcInvalidChars, loNodeText
IF LEFT(tcString, 1) != " " .AND. EMPTY(tcString)
RETURN ""
ENDIF
*-* TJF 2016-12-12 Strip out invalid XML characters (ASCII 0 to 31 except 9 (TAB), 10 (LF), and 13 (CR))
lcInvalidChars = CHR(0) + CHR(1) + CHR(2) + CHR(3) + CHR(4) + CHR(5) + CHR(6) + CHR(7) + CHR(8) + CHR(11) + CHR(12) + ;
CHR(14) + CHR(15) + CHR(16) + CHR(17) + CHR(18) + CHR(19) + CHR(20) + CHR(21) + CHR(22) + CHR(23) + ;
CHR(24) + CHR(25) + CHR(26) + CHR(27) + CHR(28) + CHR(29) + CHR(30) + CHR(31)
lcString = CHRTRAN(tcString, lcInvalidChars, "")
IF ISNULL(this.oXDOM)
lcString = STRTRAN(lcString, CHR(38), '&amp;')
lcString = STRTRAN(lcString, '>', '&gt;')
lcString = STRTRAN(lcString, '<', '&lt;')
lcString = STRTRAN(lcString, '"', '&quot;')
IF this.CodePage = 0
lcXMLString = ""
FOR lnNdx=1 TO LEN(lcString)
lcChar = SUBSTR(lcString, lnNdx, 1)
lnChar = ASC(lcChar)
lcXMLString = lcXMLString + IIF(lnChar < 128, lcChar, "&#" + TRANSFORM(lnChar) + ";")
ENDFOR
ELSE
lcXMLString = lcString
ENDIF
ELSE
loNodeText = this.oXDOM.createTextNode(lcString)
lcXMLString = loNodeText.xml
lcXMLString = STRTRAN(lcXMLString, '"', '&quot;')
ENDIF
RETURN lcXMLString
ENDPROC
PROTECTED PROCEDURE Init
LPARAMETERS tnCodePage
LOCAL loException, lnSelect
IF PCOUNT() > 0 .AND. VARTYPE(tnCodePage) = "N"
this.CodePage = tnCodePage
ENDIF
lnSelect = SELECT()
this.CreateWorkingCursors()
IF this.DeclareWinAPI
this.DeclareDLL()
ENDIF
TRY
this.oXDOM = CREATEOBJECT('MSXML2.DOMDocument')
CATCH TO loException
this.oXDOM = .NULL.
ENDTRY
this.InitalizeIdValues()
this.OnInit()
SELECT (lnSelect)
ENDPROC
PROTECTED PROCEDURE initalizeidvalues && Initializes the internal Id values
DIMENSION this.LastBorderId[1, 2]
this.LastBorderId[1, 1] = 0 && Workbook Id
this.LastBorderId[1, 2] = 0 && Last Border Id
DIMENSION this.LastCellXfsId[1, 2]
this.LastCellXfsId[1, 1] = 0 && Workbook Id
this.LastCellXfsId[1, 2] = 0 && Last CellXfs Id
DIMENSION this.LastFillId[1, 2]
this.LastFillId[1, 1] = 0 && Workbook Id
this.LastFillId[1, 2] = 0 && Last Fill Id
DIMENSION this.LastFontId[1, 2]
this.LastFontId[1, 1] = 0 && Workbook Id
this.LastFontId[1, 2] = 0 && Last Font Id
DIMENSION this.LastIndexColorId[1, 2]
this.LastIndexColorId[1, 1] = 0 && Workbook Id
this.LastIndexColorId[1, 2] = 0 && Last IndexColor Id
DIMENSION this.LastMruColorId[1, 2]
this.LastMruColorId[1, 1] = 0 && Workbook Id
this.LastMruColorId[1, 2] = 0 && Last mruColor Id
DIMENSION this.LastNumFmtId[1, 2]
this.LastNumFmtId[1, 1] = 0 && Workbook Id
this.LastNumFmtId[1, 2] = 0 && Last NumFmt Id
DIMENSION this.LastRelationId[1, 2]
this.LastRelationId[1, 1] = 0 && Workbook Id
this.LastRelationId[1, 2] = 0 && Last Relationship Id
DIMENSION this.LastSheetId[1, 2]
this.LastSheetId[1, 1] = 0 && Workbook Id
this.LastSheetId[1, 2] = 0 && Last Sheet Id
DIMENSION this.LastStringId[1, 2]
this.LastStringId[1, 1] = 0 && Workbook Id
this.LastStringId[1, 2] = 0 && Last String Id
ENDPROC
PROCEDURE insertcell && Inserts a new cell into the sheet
LPARAMETERS tnWB, tnSheet, tnRow, tnCol, tnShift
LOCAL llReturn, lnRow
IF PCOUNT() < 5
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
SELECT xl_cells
SET ORDER TO TAG reverse
DO CASE
CASE tnShift = INSERT_LEFT
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellcol >= tnCol .AND. cellrow = tnRow
REPLACE xl_cells.cellcol WITH xl_cells.cellcol + 1 IN xl_cells
this.SetRowMaxColumn(tnWB, tnSheet, xl_cells.cellrow, xl_cells.cellcol)
ENDSCAN
llReturn = True
CASE tnShift = INSERT_RIGHT
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellcol > tnCol .AND. cellrow = tnRow
REPLACE xl_cells.cellcol WITH xl_cells.cellcol + 1 IN xl_cells
this.SetRowMaxColumn(tnWB, tnSheet, xl_cells.cellrow, xl_cells.cellcol)
ENDSCAN
llReturn = True
CASE tnShift = INSERT_BEFORE
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellrow >= tnRow .AND. cellcol = tnCol
REPLACE xl_cells.cellrow WITH xl_cells.cellrow + 1 IN xl_cells
this.SetRowMaxColumn(tnWB, tnSheet, xl_cells.cellrow, xl_cells.cellcol)
ENDSCAN
llReturn = True
CASE tnShift = INSERT_AFTER
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellrow > tnRow .AND. cellcol = tnCol
REPLACE xl_cells.cellrow WITH xl_cells.cellrow + 1 IN xl_cells
this.SetRowMaxColumn(tnWB, tnSheet, xl_cells.cellrow, xl_cells.cellcol)
ENDSCAN
llReturn = True
OTHERWISE
llReturn = False
ENDCASE
SET ORDER TO
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE insertcolumn && Inserts a new column into the sheet
LPARAMETERS tnWB, tnSheet, tnCol, tnShift
LOCAL llReturn
IF PCOUNT() < 4
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
SELECT xl_cells
SET ORDER TO TAG reverse
DO CASE
CASE tnShift = INSERT_LEFT
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellcol >= tnCol
REPLACE xl_cells.cellcol WITH xl_cells.cellcol + 1 IN xl_cells
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(xl_cells.cellrow), "xl_rows", "id") .AND. xl_cells.cellcol > xl_rows.maxcol
REPLACE xl_rows.maxcol WITH xl_cells.cellcol IN xl_rows
ENDIF
ENDSCAN
llReturn = True
CASE tnShift = INSERT_RIGHT
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellcol > tnCol
REPLACE xl_cells.cellcol WITH xl_cells.cellcol + 1 IN xl_cells
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(xl_cells.cellrow), "xl_rows", "id") .AND. xl_cells.cellcol > xl_rows.maxcol
REPLACE xl_rows.maxcol WITH xl_cells.cellcol IN xl_rows
ENDIF
ENDSCAN
llReturn = True
OTHERWISE
llReturn = False
ENDCASE
SET ORDER TO
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE insertrow && Inserts a new row into the sheet
LPARAMETERS tnWB, tnSheet, tnRow, tnShift
LOCAL llReturn, lnRow
IF PCOUNT() < 4
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
SELECT xl_cells
SET ORDER TO TAG reverse
DO CASE
CASE tnShift = INSERT_BEFORE
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellrow >= tnRow
lnRow = xl_cells.cellrow
REPLACE xl_cells.cellrow WITH lnRow + 1 IN xl_cells
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(lnRow), "xl_rows", "id")
REPLACE xl_rows.row WITH xl_cells.cellrow IN xl_rows
ENDIF
ENDSCAN
llReturn = True
CASE tnShift = INSERT_AFTER
SCAN FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellrow > tnRow
lnRow = xl_cells.cellrow
REPLACE xl_cells.cellrow WITH lnRow + 1 IN xl_cells
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(lnRow), "xl_rows", "id")
REPLACE xl_rows.row WITH xl_cells.cellrow IN xl_rows
ENDIF
ENDSCAN
llReturn = True
OTHERWISE
llReturn = False
ENDCASE
SET ORDER TO
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE iscellformula && Returns True if cell contains a formula
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
LOCAL llFormula
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
llFormula = False
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
llFormula = !EMPTY(xl_cells.cellformula)
ENDIF
RETURN llFormula
ENDPROC
PROTECTED PROCEDURE iscellreferenceinvalid && Checks if the cell reference is invalid (outside of limits)
LPARAMETERS tnRow, tnCol
IF tnRow > LIMITS_MAX_ROWS .OR. tnCol > LIMITS_MAX_COLUMNS
RETURN True
ENDIF
RETURN False
ENDPROC
PROCEDURE isformatstyledefined && Determines if the format is defined as a style
LPARAMETERS tnWB, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos
DO CASE
CASE PCOUNT() < 3
RETURN .NULL.
CASE PCOUNT() = 3
tlBold = False
tlItalic = False
tnFColor = RGB(0, 0, 0)
tcULine = UNDERLINE_NONE
tlStrikThr = False
tcVPos = FONT_VERTICAL_BASELINE
CASE PCOUNT() = 4
tlItalic = False
tnFColor = RGB(0, 0, 0)
tcULine = UNDERLINE_NONE
tlStrikThr = False
tcVPos = FONT_VERTICAL_BASELINE
CASE PCOUNT() = 5
tnFColor = RGB(0, 0, 0)
tcULine = UNDERLINE_NONE
tlStrikThr = False
tcVPos = FONT_VERTICAL_BASELINE
CASE PCOUNT() = 6
tcULine = UNDERLINE_NONE
tlStrikThr = False
tcVPos = FONT_VERTICAL_BASELINE
CASE PCOUNT() = 7
tlStrikThr = False
tcVPos = FONT_VERTICAL_BASELINE
CASE PCOUNT() = 8
tcVPos = FONT_VERTICAL_BASELINE
ENDCASE
IF SEEK(BINTOC(tnWB)+PADR(tcFName, 100) + STR(tnFSize, 5, 1) + TRANSFORM(tlBold) + TRANSFORM(tlItalic) + PADL(tnFColor, 15) + PADR(tcULine, 16) + ;
TRANSFORM(tlStrikThr) + PADR(tcVPos, 11), "xl_fonts", "cellformat")
IF SEEK(BINTOC(tnWB)+BINTOC(xl_fonts.id)+BINTOC(0)+BINTOC(0)+BINTOC(0)+BINTOC(0)+BINTOC(0), "xl_cellxfs", "cellformat")
RETURN xl_cellxfs.id
ELSE
RETURN .NULL.
ENDIF
ELSE
RETURN .NULL.
ENDIF
ENDPROC
PROTECTED PROCEDURE isvalidborderstyle && Validates the border style value
LPARAMETERS tcStyle
IF VARTYPE(tcStyle) != 'C' .OR. EMPTY(tcStyle) .OR. !INLIST(tcStyle, BORDER_STYLE_THIN, BORDER_STYLE_HAIR, BORDER_STYLE_DOTTED, BORDER_STYLE_DASHDOTDOT, ;
BORDER_STYLE_DASHDOT, BORDER_STYLE_DASHED, BORDER_STYLE_THIN, BORDER_STYLE_MEDIUMDASHDOTDOT, ;
BORDER_STYLE_SLANTDASHDOT, BORDER_STYLE_MEDIUMDASHDOT, BORDER_STYLE_MEDIUMDASHED, ;
BORDER_STYLE_MEDIUM, BORDER_STYLE_THICK, BORDER_STYLE_DOUBLE)
RETURN False
ENDIF
RETURN True
ENDPROC
PROCEDURE mergecells && Merges cells together
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol
LOCAL lnRow, lnCol, lcCellValue, lnStringIndex, lcDataType, lcCellFormula, llReturn
IF PCOUNT() < 6
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnBegRow)+BINTOC(tnBegCol), "xl_mergecells", "mergecell")
REPLACE xl_mergecells.endrow WITH tnEndRow, ;
xl_mergecells.endcol WITH tnEndCol IN xl_mergecells
ELSE
*-* Check if a cell being merged is already in a merge group
SELECT xl_mergecells
LOCATE FOR workbook = tnWB .AND. sheet = tnSheet .AND. BETWEEN(tnBegRow, begrow, endrow) .AND. BETWEEN(tnBegCol, begcol, endcol) .AND. !DELETED()
IF FOUND()
llReturn = False
ELSE
LOCATE FOR workbook = tnWB .AND. sheet = tnSheet .AND. BETWEEN(tnEndRow, begrow, endrow) .AND. BETWEEN(tnEndCol, begcol, endcol) .AND. !DELETED()
IF FOUND()
llReturn = False
ELSE
*-* Add merged cells
INSERT INTO xl_mergecells (workbook, sheet, begrow, begcol, endrow, endcol) ;
VALUES (tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol)
*-* Get upper left most cell value -> will be value of the merged cells (clear all other cell values)
SELECT xl_cells
lcCellValue = .NULL.
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF this.GetCellRecord(tnWB, tnSheet, lnRow, lnCol) .AND. !EMPTY(xl_cells.cellvalue)
IF ISNULL(lcCellValue) .AND. !xl_cells.celldeleted
lcDataType = xl_cells.datatype
lcCellValue = xl_cells.cellvalue
lcCellFormula = xl_cells.cellformula
lnStringIndex = xl_cells.stringid
ENDIF
REPLACE xl_cells.cellvalue WITH "", ;
xl_cells.cellformula WITH "", ;
xl_cells.stringid WITH 0, ;
xl_cells.datatype WITH "" IN xl_cells
ENDIF
ENDFOR
ENDFOR
IF !ISNULL(lcCellValue)
IF this.GetCellRecord(tnWB, tnSheet, tnBegRow, tnBegCol)
REPLACE xl_cells.cellvalue WITH lcCellValue, ;
xl_cells.cellformula WITH lcCellFormula, ;
xl_cells.stringid WITH lnStringIndex, ;
xl_cells.datatype WITH lcDataType, ;
xl_cells.celldeleted WITH False IN xl_cells
ENDIF
ENDIF
*-* If the tnEndCol cell is not a cell already in the row then add the cell to the cursor for the max cells by row determination
* SELECT xl_cells
* FOR lnRow=tnBegRow TO tnEndRow
* LOCATE FOR workbook = tnWB .AND. sheet = tnSheet .AND. cellrow = lnRow .AND. cellcol >= tnEndCol .AND. !DELETED()
* IF !FOUND()
* INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, numdec, celldeleted) ;
* VALUES (tnWB, tnSheet, lnRow, tnEndCol, DATA_TYPE_NONE, 0, -1, False)
* ENDIF
* ENDFOR
llReturn = True
ENDIF
ENDIF
ENDIF
FOR lnRow=tnBegRow TO tnEndRow
this.SetRowMaxColumn(tnWB, tnSheet, lnRow, tnEndCol)
ENDFOR
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE ondestroy && Called by the Destroy() event - user implementation
*-*
*-* TODO: Add your code here
*-*
ENDPROC
PROCEDURE oninit && User code for Init() Event
*-*
*-* TODO: Add your code here
*-*
ENDPROC
PROCEDURE onshowerrormessage && Event for displaying an error message to the user
LPARAMETERS tnErrorId, tcErrMessage
*-*
*-* TODO: Use BINDEVENTS to bind to this event and display a message to your users
*-*
ENDPROC
PROCEDURE onshowstatusmessage && Event for displaying a wait message to the user
LPARAMETERS tnMode, tnStage, tnTotStages
*-*
*-* TODO: Use BINDEVENTS to bind to this event and display a message to your users
*-*
*-* tnTotStages = total number of tnStages (only passed on first call)
*-*
*-* tnMode = 1; opening an xlsx file
*-* tnStage = 0; start of open
*-* tnStage = 1; reading shared strings XML
*-* tnStage = 2; reading styles XML
*-* tnStage = 3; reading relationships XML
*-* tnStage = 4; reading sheets XML
*-* tnStage = 5; reading named ranges
*-* tnStage = 6; reading external references
*-* tnStage = -1; end of open
*-*
*-* tnMode = 2; saving an xlsx file
*-* tnStage = 0; start of save
*-* tnStage = 1; indicates saving supporting XMLs
*-* tnStage = 2; indicates saving strings XML
*-* tnStage = 3; indicates saving styles XML
*-* tnStage = 4; indicates saving workbook
*-* tnStage = 5; indicates saving relationship XML
*-* tnStage = 6+; indicates saving sheets
*-* tnStage = -1; end of close
*-*
*-* tnMode = 3; saving an xlsx file
*-* tnStage = 0; start of write of data to cell values
*-* tnStage = 1-n; indicates saving cell values
*-* tnStage = -1; write of data
*-*
ENDPROC
PROCEDURE opencreatedxlsxfile && Opens the XLSX file via Win32 API default program
LPARAMETERS txWB
LOCAL lcFileName
DO CASE
CASE PCOUNT() = 0
RETURN False
CASE VARTYPE(txWB) = "N"
lcFileName = this.GetWorkbookFileName(txWB)
IF EMPTY(lcFileName) .OR. !FILE(lcFileName)
RETURN False
ENDIF
CASE VARTYPE(txWB) = "C"
IF FILE(txWB)
lcFileName = txWB
ELSE
RETURN False
ENDIF
OTHERWISE
RETURN False
ENDCASE
TRY
apiShellExecute(0, "Open", lcFileName, "", "", 5)
CATCH TO loException
RAISEEVENT(this, "OnShowErrorMessage", 99, "Failure to open file: " + loException.Message)
ENDTRY
ENDPROC
PROCEDURE openxlsxworkbook && Opens the passed Xlsx workbook and loads the internal cursors with the content
LPARAMETERS tcFileName, tlForceTextFormat
LOCAL lnWB, lcBaseName, lcTempPath, lcZipName, loShell, lnCnt, lnCntTot, lcRelationsXml, lnNode
LOCAL lnRelId, lcRelType, lcTarget, lcWbXmlPath, lcRelation, lcWorkbook, lcSheet, lcShName, lnShRId, lcShFile
LOCAL loException, loFS, lcDefinedNames, lcDefinedName, lcRName, lcComment, lnRangeId, lcRange, lnNdx
LOCAL lnBegRow, lnBegCol, lnEndRow, lnEndCol, lcExternalRefs, lnExRId, lcExtRef, lcCellRange, lcBegRange
LOCAL lcEndRange, loDir, lnLastRelId, lcSheets, lcRelationships, lcShState
LOCAL ARRAY laTemp[1]
DO CASE
CASE PCOUNT() = 0
this.ErrorLevelId = 1
RAISEEVENT(this, "OnShowErrorMessage", 1, "Invalid call to OpenXlsxWorkbook() method; must include file name to open")
CASE PCOUNT() = 1
tlForceTextFormat = False
ENDCASE
lnWB = 0
IF ADIR(laTemp, tcFileName) > 0
*-* Open the Workbook as an archive (zip) file and extract contents
TRY
lcBaseName = SYS(2015)
lcTempPath = ADDBS(SYS(2023)) + lcBaseName
lcZipName = lcTempPath + ".zip"
COPY FILE (tcFileName) TO (lcZipName)
loShell = CREATEOBJECT("shell.application")
MKDIR (lcTempPath)
loShell.NameSpace(lcTempPath).CopyHere(loShell.NameSpace(lcZipName).Items, FOF_SILENT)
lnCnt = 0
lnCntTot = loShell.NameSpace(lcZipName).Items.Count
DO WHILE loShell.NameSpace(lcTempPath).Items.Count != lnCntTot
lnCnt = lnCnt + 1
apiSleep(100)
IF lnCnt > lnCntTot
SET STEP ON
ENDIF
ENDDO
ERASE (lcZipName)
CATCH TO loException
SET STEP ON
this.ErrorLevelId = 2
RAISEEVENT(this, "OnShowErrorMessage", 2, loException.Message)
lnWB = .NULL.
ENDTRY
IF ISNULL(lnWB)
RETURN 0
ENDIF
*-* Add to the workbook table
lnWB = this.CreateWorkbookEx(tcFileName)
IF lnWB > 0
*-* Verify all required XML files are present
lcWbXmlPath = ADDBS(lcTempPath)
IF ADIR(laTemp, lcWbXmlPath + "xl\workbook.xml") = 0
this.ErrorLevelId = 3
RAISEEVENT(this, "OnShowErrorMessage", 3, "Invalid XLSX file - missing workbook.xml")
this.DeleteWorkbook(lnWB)
RETURN 0
ENDIF
IF ADIR(laTemp, lcWbXmlPath + "xl\_rels\workbook.xml.rels") = 0
this.ErrorLevelId = 4
RAISEEVENT(this, "OnShowErrorMessage", 4, "Invalid XLSX file - missing workbook.xml.rels")
this.DeleteWorkbook(lnWB)
RETURN 0
ENDIF
IF ADIR(laTemp, lcWbXmlPath + "xl\styles.xml") = 0
this.ErrorLevelId = 5
RAISEEVENT(this, "OnShowErrorMessage", 5, "Invalid XLSX file - missing styles.xml")
this.DeleteWorkbook(lnWB)
RETURN 0
ENDIF
*-* Process the workbook
RAISEEVENT(this, "OnShowStatusMessage", 1, 1, 6)
TRY
*-* Get the shared strings if present
IF ADIR(laTemp, lcWbXmlPath + "xl\sharedStrings.xml") > 0
IF !this.ReadSharedStringsXML(lcWbXmlPath, lnWB)
this.ErrorLevelId = 7
RAISEEVENT(this, "OnShowErrorMessage", 7, "Invalid XLSX file - error during shared string loading")
THROW
ENDIF
ENDIF
*-* Get the cell formatting styles
this.ReadStylesXML(lcWbXmlPath, lnWB)
*-* Get the defined relationship files for this workbook
RAISEEVENT(this, "OnShowStatusMessage", 1, 3)
lcRelationsXml = FILETOSTR(lcWbXmlPath + "xl\_rels\workbook.xml.rels")
lcRelationships = this.GetNodeElement(lcRelationsXml, 'Relationships', 1, False, 1)
lnNode = 1
lnLastRelId = 0
lcRelation = this.GetNodeElement(lcRelationships, 'Relationship', lnNode)
DO WHILE !EMPTY(lcRelation)
lnRelId = CAST(SUBSTR(this.GetNodeAttributeValue(lcRelation, "Id"), 4) AS I)
lcTarget = this.GetNodeAttributeValue(lcRelation, "Target")
lcRelType = this.GetNodeAttributeValue(lcRelation, "Type")
lcRelType = SUBSTR(lcRelType, RATC("/", lcRelType)+1)
IF lcRelType != "theme"
INSERT INTO xl_relationships (workbook, relid, reltype, target) VALUES (lnWB, lnRelId, lcRelType, lcTarget)
IF lnRelId > lnLastRelId
lnLastRelId = lnRelId
ENDIF
ENDIF
lnNode = lnNode + 1
lcRelation = this.GetNodeElement(lcRelationships, 'Relationship', lnNode)
ENDDO
this.SetLastId(lnWB, lnLastRelId, "xl_relationships")
*-* Get the sheets
RAISEEVENT(this, "OnShowStatusMessage", 1, 4)
lcWorkbook = FILETOSTR(lcWbXmlPath + "xl\workbook.xml")
lcSheets = this.GetNodeElement(lcWorkbook, 'sheets', 1, False, 1)
lnNode = 1
lcSheet = this.GetNodeElement(lcSheets, 'sheet', lnNode)
DO WHILE !EMPTY(lcSheet)
lcShName = this.GetNodeAttributeValue(lcSheet, "name")
lnShRId = CAST(SUBSTR(this.GetNodeAttributeValue(lcSheet, "r:id"), 4) AS I)
lcShFile = lcWbXmlPath + "xl\" + this.GetRelationshipFileName(lnWB, lnShRId)
lcShState = this.GetNodeAttributeValue(lcSheet, "state")
DO CASE
CASE lcShState = "visible"
lnShState = VISIBLE_SHEET_STATE
CASE lcShState = "hidden"
lnShState = HIDDEN_SHEET_STATE
CASE lcShState = "veryHidden"
lnShState = VERYHIDDEN_SHEET_STATE
OTHERWISE
lnShState = VISIBLE_SHEET_STATE
ENDCASE
IF ADIR(laTemp, lcShFile) = 0 .OR. !this.ReadSheetXML(lcShFile, lnWB, lnNode, lcShName, lnShState, tlForceTextFormat)
this.ErrorLevelId = 8
RAISEEVENT(this, "OnShowErrorMessage", 8, "Invalid XLSX file - missing sheet or invalid sheet: " + lcShFile)
this.DeleteWorkbook(lnWB)
THROW
ENDIF
IF SEEK(BINTOC(lnWB)+BINTOC(lnShRId), "xl_relationships", "relid")
REPLACE xl_relationships.sheet WITH lnNode IN xl_relationships
ELSE
SET STEP ON
ENDIF
lnNode = lnNode + 1
lcSheet = this.GetNodeElement(lcSheets, 'sheet', lnNode)
ENDDO
this.SetLastId(lnWB, lnNode-1, "xl_sheets")
*-* Get the defined name ranges
RAISEEVENT(this, "OnShowStatusMessage", 1, 5)
lcDefinedNames = this.GetNodeElement(lcWorkbook, 'definedNames', 1)
IF !EMPTY(lcDefinedNames)
lnNode = 1
lcDefinedName = this.GetNodeElement(lcDefinedNames, 'definedName', lnNode)
DO WHILE !EMPTY(lcDefinedName)
lcRange = this.GetNodeElementValue(lcDefinedName)
IF !EMPTY(lcRange)
lnNdx = ATC("!", lcRange)
lcShName = LEFT(lcRange, lnNdx-1)
IF !EMPTY(lcShName)
lcShName = CHRTRAN(lcShName, "'", "")
IF SEEK(BINTOC(lnWB)+UPPER(PADR(lcShName, LEN(xl_sheets.shname))), "xl_sheets", "shname")
lcRName = this.GetNodeAttributeValue(lcDefinedName, "name")
lcComment = this.GetNodeAttributeValue(lcDefinedName, "comment")
lnRangeId = CAST(this.GetNodeAttributeValue(lcDefinedName, "localSheetId") AS I)
lcCellRange = SUBSTR(lcRange, lnNdx+1)
lcCellRange = CHRTRAN(lcCellRange, "$", "")
lcBegRange = GETWORDNUM(lcCellRange, 1, ":")
lcEndRange = GETWORDNUM(lcCellRange, 2, ":")
lnNdx = this.GetAlphaNumericSplit(lcBegRange)
DO CASE
CASE lnNdx = 0 && Column only range
lnBegCol = this.ColumnAsciiToIndex(lcBegRange)
lnBegRow = 0
CASE lnNdx = 1 && Row only range
lnBegCol = 0
lnBegRow = CAST(lcBegRange AS I)
OTHERWISE
lnBegCol = this.ColumnAsciiToIndex(LEFT(lcBegRange, lnNdx-1))
lnBegRow = CAST(SUBSTR(lcBegRange, lnNdx) AS I)
ENDCASE
lnNdx = this.GetAlphaNumericSplit(lcEndRange)
DO CASE
CASE lnNdx = 0 && Column only range
lnEndCol = this.ColumnAsciiToIndex(lcEndRange)
lnEndRow = 0
CASE lnNdx = 1 && Row only range
lnEndCol = 0
lnEndRow = CAST(lcEndRange AS I)
OTHERWISE
lnEndCol = this.ColumnAsciiToIndex(LEFT(lcEndRange, lnNdx-1))
lnEndRow = CAST(SUBSTR(lcEndRange, lnNdx) AS I)
ENDCASE
INSERT INTO xl_namerange (workbook, sheet, rname, scope, comment, begrow, begcol, endrow, endcol) ;
VALUES (lnWB, xl_sheets.sheet, lcRName, lnRangeId, lcComment, lnBegRow, lnBegCol, lnEndRow, lnEndCol)
ENDIF
ENDIF
ENDIF
lnNode = lnNode + 1
lcDefinedName = this.GetNodeElement(lcDefinedNames, 'definedName', lnNode)
ENDDO
ENDIF
*-* Get the external references
RAISEEVENT(this, "OnShowStatusMessage", 1, 6)
* lcExternalRefs = this.GetNodeElement(lcWorkbook, 'externalReferences', 1)
* IF !EMPTY(lcExternalRefs)
* lnNode = 1
* lcExtRef = this.GetNodeElement(lcExternalRefs, 'externalReference', lnNode)
* DO WHILE !EMPTY(lcExtRef)
* lnExRId = CAST(SUBSTR(this.GetNodeAttributeValue(lcExtRef, "r:id"), 4) AS I)
* lcFile = lcWbXmlPath + "xl\" + this.GetRelationshipFileName(lnWB, lnExRId)
* this.ReadExternalRefXML(lnWB, lcFile, lnExRId)
*
* lnNode = lnNode + 1
* lcExtRef = this.GetNodeElement(lcExternalRefs, 'externalReference', lnNode)
* ENDDO
* ENDIF
CATCH TO loException
SET STEP ON
this.ErrorLevelId = 9
RAISEEVENT(this, "OnShowErrorMessage", 9, "Invalid XLSX file - error reading data; " + loException.Message)
this.DeleteWorkbook(lnWB)
lnWB = 0
FINALLY
TRY
loFS = CREATEOBJECT("Scripting.FileSystemObject")
loDir = loFS.GetFolder(lcTempPath)
loDir.Delete()
CATCH TO loException
SET STEP ON
ENDTRY
RAISEEVENT(this, "OnShowStatusMessage", 1, -1)
ENDTRY
IF this.Debug
this.DebugCursorsToFile("Extract")
ENDIF
ENDIF
ENDIF
RETURN lnWB
ENDPROC
PROCEDURE parsestring && Parses a string based on a specified delimiter
LPARAMETERS tcText, tnPos, tcDelimiter
LOCAL lcWord, lnCnt, lnBeg, lnEnd
lnCnt = OCCURS(tcDelimiter, tcText) + 1
IF tnPos <= lnCnt
DO CASE
CASE lnCnt = 0
lcWord = tcText
CASE tnPos = 1
lcWord = LEFT(tcText, ATC(tcDelimiter, tcText)-1)
CASE tnPos = lnCnt
lcWord = SUBSTR(tcText, RATC(tcDelimiter, tcText)+1)
OTHERWISE
lnBeg = ATC(tcDelimiter, tcText, tnPos-1) + 1
lnEnd = ATC(tcDelimiter, tcText, tnPos)
lcWord = SUBSTR(tcText, lnBeg, lnEnd-lnBeg)
ENDCASE
RETURN lcWord
ELSE
RETURN ""
ENDIF
ENDPROC
PROTECTED PROCEDURE readcellvalueformat && Reads the cell value and format for a sheet
LPARAMETERS tnWB, tcColumn, tnCellCol
LOCAL lcCellType, lnNode, lcBaseName, lcFormatCode, lnNdx, loCellFormat, lcWholeNbr, lcDecNbr
LOCAL lcPosFormat, lcNegFormat, lcZerFormat, lcInLineTxt
loCellFormat = CREATEOBJECT("Empty")
ADDPROPERTY(loCellFormat, "CellVal", "")
ADDPROPERTY(loCellFormat, "DataType", DATA_TYPE_NONE)
ADDPROPERTY(loCellFormat, "Formula", "")
ADDPROPERTY(loCellFormat, "StringNdx", 0)
ADDPROPERTY(loCellFormat, "CellXfsId", 0)
lcCellType = this.GetNodeAttributeValue(tcColumn, "t")
FOR lnChild=1 TO this.GetChildNodeCount(tcColumn)
lcChild = this.GetChildNodeElement(tcColumn, lnChild)
DO CASE
CASE lcChild = "<f" && Formula attribute - cell contains a formula
lcCellType = "f"
loCellFormat.Formula = this.GetCellFormulaFromXML(lcChild, tnCellCol)
CASE lcChild = "<v" && Value assigned to cell
loCellFormat.CellVal = this.GetNodeElementValue(lcChild)
CASE lcChild = "<is" && Value assigned to cell as inline text
lcInLineTxt = this.GetNodeElement(lcChild, 't', 1)
loCellFormat.CellVal = this.GetNodeElementValue(lcInLineTxt)
ENDCASE
ENDFOR
loCellFormat.CellXfsId = CAST(this.GetNodeAttributeValue(tcColumn, "s") AS I)
DO CASE
CASE lcCellType == "f"
loCellFormat.DataType = DATA_TYPE_FORMULA
CASE lcCellType == "s" .OR. lcCellType == "str"
loCellFormat.StringNdx = CAST(loCellFormat.CellVal AS I)
loCellFormat.CellVal = "StringValue"
loCellFormat.DataType = DATA_TYPE_CHAR
CASE lcCellType == "inlineStr"
loCellFormat.StringNdx = this.AddStringValue(tnWB, loCellFormat.CellVal, False)
loCellFormat.CellVal = "StringValue"
loCellFormat.DataType = DATA_TYPE_CHAR
CASE EMPTY(loCellFormat.CellVal)
RETURN loCellFormat
OTHERWISE
*-* Determine the data type of the value based on assigned format
IF SEEK(BINTOC(tnWB)+BINTOC(loCellFormat.CellXfsId), "xl_cellxfs", "id")
DO CASE
CASE INLIST(xl_cellxfs.numFmtId, 1, 3, 37, 38) && Integer format
loCellFormat.DataType = DATA_TYPE_INT
CASE INLIST(xl_cellxfs.numFmtId, 2, 4, 7, 8, 11, 12, 13, 39, 40) && Float format
loCellFormat.DataType = DATA_TYPE_FLOAT
CASE INLIST(xl_cellxfs.numFmtId, 9, 10) && Numeric percent format
loCellFormat.DataType = DATA_TYPE_FLOAT
CASE INLIST(xl_cellxfs.numFmtId, 14, 15, 16, 17) && Date format
DO CASE
CASE ATC(".", loCellFormat.CellVal) = 0 .OR. RIGHT(loCellFormat.CellVal, 1) = "."
loCellFormat.DataType = DATA_TYPE_DATE
CASE ATC(".", loCellFormat.CellVal) > 0
lnNdx = ATC(".", loCellFormat.CellVal)
lcWholeNbr = LEFT(loCellFormat.CellVal, lnNdx-1)
lcDecNbr = SUBSTR(loCellFormat.CellVal, lnNdx+1)
IF LEN(lcDecNbr) > 0
loCellFormat.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCellFormat.DataType = DATA_TYPE_DATETIME
ELSE
loCellFormat.CellVal = lcWholeNbr
loCellFormat.DataType = DATA_TYPE_DATE
ENDIF
ENDCASE
CASE INLIST(xl_cellxfs.numFmtId, 18, 19, 20, 21, 45, 46) && Time format
DO CASE
CASE ATC("E-", loCellFormat.CellVal) > 0
loCellFormat.CellVal = PADR(TRANSFORM(EVAL(loCellFormat.CellVal)), 19, "0")
loCellFormat.DataType = DATA_TYPE_TIME
CASE ATC("E", loCellFormat.CellVal) > 0
loCellFormat.CellVal = TRANSFORM(EVAL(loCellFormat.CellVal))
lnNdx = ATC(".", loCellFormat.CellVal)
lcWholeNbr = LEFT(loCellFormat.CellVal, lnNdx-1)
lcDecNbr = SUBSTR(loCellFormat.CellVal, lnNdx+1)
loCellFormat.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCellFormat.DataType = DATA_TYPE_DATETIME
CASE LEFT(loCellFormat.CellVal, 2) = "0."
lcDecNbr = SUBSTR(loCellFormat.CellVal, 3)
loCellFormat.CellVal = "0." + PADR(lcDecNbr, 17, "0")
loCellFormat.DataType = DATA_TYPE_TIME
OTHERWISE
lnNdx = ATC(".", loCellFormat.CellVal)
lcWholeNbr = LEFT(loCellFormat.CellVal, lnNdx-1)
lcDecNbr = SUBSTR(loCellFormat.CellVal, lnNdx+1)
loCellFormat.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCellFormat.DataType = DATA_TYPE_DATETIME
ENDCASE
CASE INLIST(xl_cellxfs.numFmtId, 22, 29, 30, 31, 32, 33, 34) && Date-time format
lnNdx = ATC(".", loCellFormat.CellVal)
lcWholeNbr = IIF(lnNdx=0, loCellFormat.CellVal, LEFT(loCellFormat.CellVal, lnNdx-1)) && Bug fix provide by Dan Goodwin from VFPx
lcDecNbr = IIF(lnNdx=0, "", SUBSTR(loCellFormat.CellVal, lnNdx+1)) && Bug fix provide by Dan Goodwin from VFPx
loCellFormat.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCellFormat.DataType = DATA_TYPE_DATETIME
CASE xl_cellxfs.numFmtId = 49 && Numeric formatted as text
loCellFormat.StringNdx = this.AddStringValue(tnWB, loCellFormat.CellVal, False)
loCellFormat.CellVal = "StringValue"
loCellFormat.DataType = DATA_TYPE_CHAR
CASE SEEK(BINTOC(tnWB)+BINTOC(xl_cellxfs.numFmtId), "xl_numfmts", "id") && Determine based on custom format
lcFormatCode = ALLTRIM(xl_numfmts.formatcode)
DO CASE
CASE ATC("h:m", lcFormatCode) > 0 .OR. ATC("m:s", lcFormatCode) > 0 .OR. ATC("AM/PM", lcFormatCode) > 0 .OR. ATC("A/P", lcFormatCode) > 0
loCellFormat.DataType = DATA_TYPE_DATETIME
CASE ATC("yy", lcFormatCode) > 0 .OR. ATC("d\-m", lcFormatCode) > 0
loCellFormat.DataType = DATA_TYPE_DATE
OTHERWISE
lnNdx = ATC(".", lcFormatCode)
IF lnNdx > 0
loCellFormat.DataType = DATA_TYPE_FLOAT
lnNdx = lnNdx + 1
DO WHILE lnNdx < LEN(lcFormatCode)
IF SUBSTR(lcFormatCode, lnNdx, 1) != "0"
EXIT
ENDIF
lnNdx = lnNdx + 1
ENDDO
ELSE
loCellFormat.DataType = DATA_TYPE_INT
ENDIF
ENDCASE
OTHERWISE
DO CASE
CASE ISNULL(loCellFormat.CellVal) .OR. EMPTY(loCellFormat.CellVal)
loCellFormat.DataType = DATA_TYPE_NONE
CASE ATC(".", loCellFormat.CellVal) > 0
loCellFormat.DataType = DATA_TYPE_FLOAT
OTHERWISE
loCellFormat.DataType = DATA_TYPE_INT
ENDCASE
ENDCASE
ELSE
DO CASE
CASE ISNULL(loCellFormat.CellVal) .OR. EMPTY(loCellFormat.CellVal)
loCellFormat.CellVal = ""
loCellFormat.DataType = DATA_TYPE_NONE
CASE ATC(".", loCellFormat.CellVal) > 0
loCellFormat.DataType = DATA_TYPE_FLOAT
OTHERWISE
loCellFormat.DataType = DATA_TYPE_INT
ENDCASE
ENDIF
ENDCASE
RETURN loCellFormat
ENDPROC
PROTECTED PROCEDURE readexternalrefxml && Reads the External References file
LPARAMETERS tnWB, tcFileName, tnRelId
LOCAL lcExternalLink, lcSheetNames, lnNode, lcSheetName, lcShName
*-* Open the external file for processing
lcExternalLink = FILETOSTR(tcFileName)
*-* Get the sheet names
lcSheetNames = this.GetNodeElement(lcExternalLink, 'sheetNames', 1)
IF !EMPTY(lcSheetNames)
lnNode = 1
lcSheetName = this.GetNodeElement(lcSheetNames, 'sheetName', lnNode)
DO WHILE !EMPTY(lcSheetName)
lcShName = this.GetNodeAttributeValue(lcSheetName, "val")
INSERT INTO xl_extsheets (workbook, extid, relid, sheetname) VALUES (tnWB, lnNode, tnRelId, lcShName)
lnNode = lnNode + 1
lcSheetName = this.GetNodeElement(lcSheetNames, 'sheetName', lnNode)
ENDDO
*-* Get each external sheet detail
lnNode = 1
lcSheetData = this.GetNodeElement(lcExternalLink, 'sheetData', lnNode)
DO WHILE !EMPTY(lcSheetData)
lnRow = 1
lcRowData = this.GetNodeElement(lcSheetData, 'row', lnRow)
DO WHILE !EMPTY(lcRowData)
ENDDO
lnNode = lnNode + 1
lcSheetData = this.GetNodeElement(lcExternalLink, 'sheetData', lnNode)
ENDDO
ENDIF
ENDPROC
PROTECTED PROCEDURE readsharedstringsxml && Reads the sharedstrings.xml for opening workbooks
LPARAMETERS tcFilePath, tnWB
LOCAL lcStrings, lcString, lnNode, lcRichTextRun, lcText, lnIndex, llFBold, llFItalic, loException, lcT
LOCAL lnFColor, lcFName, lnFSize, lcULine, llStrkThr, lcFVPos, lnTheme, lnTint, lnIndexed, lcRunPrp
LOCAL lnR, lcRText, lcRunProp, lcColor, llPrsvSp, llFormatted, llSuccess, lhFile, lcSharedStringFile, lnSize
LOCAL lcStringXml, lcCheckSum
RAISEEVENT(this, "OnShowStatusMessage", 1, 1)
TRY
lcSharedStringFile = ADDBS(tcFilePath) + "xl\sharedStrings.xml"
lcStrings = FILETOSTR(lcSharedStringFile)
IF this.CodePage = 0
lcStrings = STRCONV(lcStrings, 11)
ELSE
lcStrings = STRCONV(lcStrings, 11, this.CodePage, 1)
ENDIF
lnNode = 1
lcString = this.GetNodeElement(lcStrings, 'si', lnNode)
DO WHILE !EMPTY(lcString)
lnR = 1
lcRichTextRun = this.GetNodeElement(lcString, 'r', lnR, True)
IF EMPTY(lcRichTextRun)
llFormatted = False
lcT = this.GetNodeElement(lcString, 't', 1)
lcText = this.GetNodeElementValue(lcT)
llPrsvSp = IIF(EMPTY(this.GetNodeAttributeValue(lcT, "xml:space")), False, True)
IF llPrsvSp
lcRText = CHRTRAN(lcText, CHR(32), CHR(160))
ENDIF
ELSE
llFormatted = True
lcText = ""
lnIndex = 0
DO WHILE !EMPTY(lcRichTextRun)
lnIndex = lnIndex + 1
lcT = this.GetNodeElement(lcRichTextRun, 't', 1)
llPrsvSp = IIF(EMPTY(this.GetNodeAttributeValue(lcT, "xml:space")), False, True)
lcRText = this.GetNodeElementValue(lcT)
lcText = lcText + lcRText
lcRunProp = this.GetNodeElement(lcRichTextRun, 'rPr', 1, True)
llFBold = IIF(ATC("<b/>", lcRunProp)>0, True, False)
llFItalic = IIF(ATC("<i/>", lcRunProp)>0, True, False)
llStrkthr = IIF(ATC("<strike/>", lcRunProp)>0, True, False)
IF ATC("<u/>", lcRunProp) > 0
lcULine = UNDERLINE_SINGLE
ELSE
lcULine = this.GetNodeAttributeValue(this.GetNodeElement(lcRunProp, 'u', 1), "val")
lcULine = IIF(EMPTY(lcULine), UNDERLINE_NONE, lcULine)
ENDIF
lnFSize = CAST(this.GetNodeAttributeValue(this.GetNodeElement(lcRunProp, 'sz', 1), "val") AS I)
lcFName = this.GetNodeAttributeValue(this.GetNodeElement(lcRunProp, 'rFont', 1), "val")
lcFVPos = this.GetNodeAttributeValue(this.GetNodeElement(lcRunProp, 'vertAlign', 1), "val")
lcColor = this.GetNodeElement(lcRunProp, 'color', 1)
lnFColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnTheme = CAST(this.GetNodeAttributeValue(lcColor, "theme") AS I)
lnTint = CAST(this.GetNodeAttributeValue(lcColor, "tint") AS I)
lnIndexed = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
IF llPrsvSp
lcRText = CHRTRAN(lcRText, CHR(32), CHR(160))
ENDIF
INSERT INTO xl_strformat (workbook, id, index, stringxml, stringval, fbold, fitalic, fcolor, fname, fsize, uline, strkthr, fvpos, theme, tint, indexed, presvspace) ;
VALUES (tnWB, lnNode-1, lnIndex, lcRText, this.GetStringXML(lcRText), llFBold, llFItalic, lnFColor, lcFName, lnFSize, lcULine, llStrkThr, ;
lcFVPos, lnTheme, lnTint, lnIndexed, llPrsvSp)
lnR = lnR + 1
lcRichTextRun = this.GetNodeElement(lcString, 'r', lnR, True)
ENDDO
llPrsvSp = False
ENDIF
lcStringXml = this.GetXMLString(lcText)
lcCheckSum = this.GetCheckSum(lcText)
INSERT INTO xl_strings (id, workbook, checksum, stringxml, stringval, presvspace, formatted) ;
VALUES (lnNode-1, tnWB, lcCheckSum, lcText, lcStringXml, llPrsvSp, llFormatted)
lnNode = lnNode + 1
lcString = this.GetNodeElement(lcStrings, 'si', lnNode)
ENDDO
this.SetLastId(tnWB, lnNode-2, "xl_strings") && Decrement by 2 to account for empty string not assigned
llSuccess = True
CATCH TO loException
SET STEP ON
llSuccess = False
ENDTRY
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE readsheetxml && Reads the sheet.xml for opening a workbook
LPARAMETERS tcShFile, tnWB, tnSheet, tcShName, tnShState, tlForceTextFormat
LOCAL lcSheet, lcSheetViews, lcSheetView, lcPane, lcMargin, lnXSplit, lnYSplit, lnLeft, lcDimen, lnScale, lnFitToWidth, lnFitToHeight
LOCAL lnRight, lnTop, lnBottom, lnHeader, lnFooter, lcPageSetup, lnOrientation, lnPaperSize, lnWidth, lnHeight, lnNode, lcMergeCells
LOCAL lnCnt, lcMergeCell, lcCellRef, lnBegCol, lnBegRow, lnEndCol, lnEndRow, lcTemp, lnNdx, lcSheetData
LOCAL lcRow, lnRowHt, lnCellRow, lnCellCol, lnCol, loCell, lnTabColNdx, lcTabColRgb, lcTabColor, lcSheetPr
LOCAL lcValidations, lnValidType, lcValidation, lnValidStyle, lnOperator, lcErrMsg, lcErrTitle, lcPrompt, lcFormula1
LOCAL lcFormula2, llAllowBlank, llShowInputMsg, llShowErrMsg, llFormula, llCustHt, lcValidType, lcValidStyle
LOCAL lcValidSqRef, lnIndex
*-* Open the sheet for processing
lcSheet = FILETOSTR(tcShFile)
IF this.CodePage = 0
lcSheet = STRCONV(lcSheet, 11)
ELSE
lcSheet = STRCONV(lcSheet, 11, this.CodePage, 1)
ENDIF
*-* Get the freeze rows/columns settings
lcSheetViews = this.GetNodeElement(lcSheet, 'sheetViews', 1, True)
lcSheetView = this.GetNodeElement(lcSheetViews, 'sheetView', 1)
lcPane = this.GetNodeElement(lcSheetView, 'pane', 1)
lnXSplit = CAST(this.GetNodeAttributeValue(lcPane, "xSplit") AS I)
lnYSplit = CAST(this.GetNodeAttributeValue(lcPane, "ySplit") AS I)
*-* Get the tab color settings
lcSheetPr = this.GetNodeElement(lcSheet, 'sheetPr', 1)
IF EMPTY(lcSheetPr)
lnTabColNdx = 0
lcTabColRgb = ""
ELSE
lcTabColor = this.GetNodeElement(lcSheetPr, 'tabColor', 1)
lnTabColNdx = CAST(this.GetNodeAttributeValue(lcTabColor, "indexed") AS I)
lcTabColRgb = this.GetNodeAttributeValue(lcTabColor, "rgb")
ENDIF
*-* Get the worksheet margins
lcMargin = this.GetNodeElement(lcSheet, 'pageMargins', 1)
lnLeft = CAST(this.GetNodeAttributeValue(lcMargin, "left") AS N(6,3))
lnLeft = IIF(lnLeft = 0.000, 0.75, lnLeft)
lnRight = CAST(this.GetNodeAttributeValue(lcMargin, "right") AS N(6,3))
lnRight = IIF(lnRight = 0.000, 0.75, lnRight)
lnTop = CAST(this.GetNodeAttributeValue(lcMargin, "top") AS N(6,3))
lnTop = IIF(lnTop = 0.000, 0.75, lnTop)
lnBottom = CAST(this.GetNodeAttributeValue(lcMargin, "bottom") AS N(6,3))
lnBottom = IIF(lnBottom = 0.000, 0.75, lnBottom)
lnFooter = CAST(this.GetNodeAttributeValue(lcMargin, "footer") AS N(6,3))
lnFooter = IIF(lnFooter = 0.000, 0.30, lnFooter)
lnHeader = CAST(this.GetNodeAttributeValue(lcMargin, "header") AS N(6,3))
lnHeader = IIF(lnHeader = 0.000, 0.30, lnHeader)
*-* Get the page setup
lcPageSetup = this.GetNodeElement(lcSheet, 'pageMargins', 1)
lnOrientation = IIF(this.GetNodeAttributeValue(lcPageSetup, "orientation")='portrait', PORTRAIT_PRINT_ORIENTATION, LANDSCAPE_PRINT_ORIENTATION)
lnPaperSize = CAST(this.GetNodeAttributeValue(lcPageSetup, "paperSize") AS I)
lnPaperSize = IIF(lnPaperSize=0, PAPERSIZE_LTR, lnPaperSize)
lnWidth = CAST(this.GetNodeAttributeValue(lcPageSetup, "paperWidth") AS I)
lnHeight = CAST(this.GetNodeAttributeValue(lcPageSetup, "paperHeight") AS I)
lcDimen = RIGHT(this.GetNodeAttributeValue(lcPageSetup, "paperHeight"), 2)
lnScale = CAST(this.GetNodeAttributeValue(lcPageSetup, "scale") AS I)
lnScale = IIF(lnScale=0, 100, lnScale)
lnFitToWidth = CAST(this.GetNodeAttributeValue(lcPageSetup, "fitToWidth") AS I)
lnFitToHeight = CAST(this.GetNodeAttributeValue(lcPageSetup, "fitToHeight") AS I)
*-* Save the worksheet to the cursor
INSERT INTO xl_sheets (workbook, sheet, shname, state, mleft, mright, mtop, mbot, mheader, mfooter, shdeleted, xsplit, ysplit, prnorient, ;
papersize, paperwidth, paperheight, paperdimen, scale, fittowidth, fittoheight, tabcolorndx, tabcolorrgb) ;
VALUES (tnWB, tnSheet, tcShName, tnShState, lnLeft, lnRight, lnTop, lnBottom, lnHeader, lnFooter, False, lnXSplit, lnYSplit, lnOrientation, ;
lnPaperSize, lnWidth, lnHeight, lcDimen, lnScale, lnFitToWidth, lnFitToHeight, lnTabColNdx, lcTabColRgb)
*-* Get the defined column widths
lcCols = this.GetNodeElement(lcSheet, 'cols', 1, True)
lnNode = 1
lcCol = this.GetNodeElement(lcCols, 'col', lnNode)
DO WHILE !EMPTY(lcCol)
lnMinCol = CAST(this.GetNodeAttributeValue(lcCol, "min") AS I)
lnMaxCol = CAST(this.GetNodeAttributeValue(lcCol, "max") AS I)
lnWidth = CAST(this.GetNodeAttributeValue(lcCol, "width") AS N(16,9)) - 0.71093750
FOR lnCol=lnMinCol TO lnMaxCol
INSERT INTO xl_colwidths (workbook, sheet, COLUMN, width) VALUES (tnWB, tnSheet, lnCol, lnWidth)
ENDFOR
lnNode = lnNode + 1
lcCol = this.GetNodeElement(lcCols, 'col', lnNode)
ENDDO
*-* Get the defined merged cells
lcMergeCells = this.GetNodeElement(lcSheet, 'mergeCells', 1)
lnCnt = CAST(this.GetNodeAttributeValue(lcMergeCells, "count") AS I)
FOR lnNode=1 TO lnCnt
lcMergeCell = this.GetNodeElement(lcMergeCells, 'mergeCell', lnNode)
IF EMPTY(lcMergeCell)
SET STEP ON
LOOP
ENDIF
lcCellRef = this.GetNodeAttributeValue(lcMergeCell, "ref")
lnBegCol = 0
lnBegRow = 0
lnEndCol = 0
lnEndRow = 0
lcTemp = GETWORDNUM(lcCellRef, 1, ":")
lnNdx = 0
DO WHILE lnNdx < LEN(lcTemp)
lnNdx = lnNdx + 1
IF ISDIGIT(SUBSTR(lcTemp, lnNdx, 1))
lnBegCol = this.ColumnAsciiToIndex(LEFT(lcTemp, lnNdx-1))
lnBegRow = INT(VAL(SUBSTR(lcTemp, lnNdx)))
EXIT
ENDIF
ENDDO
IF lnBegCol > 0
lcTemp = GETWORDNUM(lcCellRef, 2, ":")
lnNdx = 0
DO WHILE lnNdx < LEN(lcTemp)
lnNdx = lnNdx + 1
IF ISDIGIT(SUBSTR(lcTemp, lnNdx, 1))
lnEndCol = this.ColumnAsciiToIndex(LEFT(lcTemp, lnNdx-1))
lnEndRow = INT(VAL(SUBSTR(lcTemp, lnNdx)))
EXIT
ENDIF
ENDDO
IF lnEndCol > 0
INSERT INTO xl_mergecells (workbook, sheet, begrow, begcol, endrow, endcol) ;
VALUES (tnWB, tnSheet, lnBegRow, lnBegCol, lnEndRow, lnEndCol)
ENDIF
ENDIF
ENDFOR
*-* Get the sheet cell values and formatting
lcSheetData = this.GetNodeElement(lcSheet, 'sheetData', 1, True)
lnNode = 1
lcRow = this.GetNodeElement(lcSheetData, 'row', lnNode)
DO WHILE !EMPTY(lcRow) && Process each row in the sheet
lnCellRow = CAST(this.GetNodeAttributeValue(lcRow, "r") AS I)
lnRowHt = CAST(this.GetNodeAttributeValue(lcRow, "ht") AS N(14,7))
llCustHt = IIF(CAST(this.GetNodeAttributeValue(lcRow, "customHeight") AS I) = 1, True, False)
IF llCustHt .OR. (lnRowHt > 0.00 .AND. lnRowHt != 30)
INSERT INTO xl_rowheights (workbook, sheet, row, height) VALUES (tnWB, tnSheet, lnCellRow, lnRowHt)
ENDIF
lnCol = 1
lnCellCol = 1
lcColumn = this.GetNodeElement(lcRow, 'c', lnCol)
DO WHILE !EMPTY(lcColumn) && Process each column in a row
lnCellCol = this.ColumnAsciiToIndex(this.GetNodeAttributeValue(lcColumn, "r"))
loCell = this.ReadCellValueFormat(tnWB, lcColumn, lnCellCol)
IF tlForceTextFormat .AND. loCell.DataType != DATA_TYPE_CHAR
loCell.DataType = DATA_TYPE_CHAR
loCell.StringNdx = this.AddStringValue(tnWB, TRANSFORM(loCell.CellVal), False)
loCell.CellVal = "StringValue"
loCell.Formula = ""
ENDIF
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, cellvalue, datatype, cellformula, stringid, cellxfs, celldeleted) ;
VALUES (tnWB, tnSheet, lnCellRow, lnCellCol, loCell.CellVal, loCell.DataType, loCell.Formula, loCell.StringNdx, loCell.CellXfsId, False)
lnCol = lnCol + 1
lcColumn = this.GetNodeElement(lcRow, 'c', lnCol)
ENDDO
INSERT INTO xl_rows (workbook, sheet, row, maxcol) VALUES (tnWB, tnSheet, lnCellRow, lnCellCol)
lnNode = lnNode + 1
lcRow = this.GetNodeElement(lcSheet, 'row', lnNode)
ENDDO
*-* Get the validations
lcValidations = this.GetNodeElement(lcSheet, 'dataValidations', 1)
lnCnt = CAST(this.GetNodeAttributeValue(lcValidations, "count") AS I)
FOR lnNode=1 TO lnCnt
lcValidation = this.GetNodeElement(lcValidations, 'dataValidation', lnNode)
IF EMPTY(lcValidation)
SET STEP ON
LOOP
ENDIF
lcValidSqRef = this.GetNodeAttributeValue(lcValidation, "sqref")
IF EMPTY(lcValidSqRef)
SET STEP ON
LOOP
ENDIF
lcValidType = this.GetNodeAttributeValue(lcValidation, "type")
DO CASE
CASE lcValidType = "none"
lnValidType = NONE_VALID_TYPE
CASE lcValidType = "whole"
lnValidType = WHOLE_VALID_TYPE
CASE lcValidType = "decimal"
lnValidType = DECIMAL_VALID_TYPE
CASE lcValidType = "list"
lnValidType = LIST_VALID_TYPE
CASE lcValidType = "date"
lnValidType = DATE_VALID_TYPE
CASE lcValidType = "time"
lnValidType = TIME_VALID_TYPE
CASE lcValidType = "textLength"
lnValidType = TXTLEN_VALID_TYPE
CASE lcValidType = "custom"
lnValidType = CUSTOM_VALID_TYPE
OTHERWISE
lnValidType = NONE_VALID_TYPE
ENDCASE
lcValidStyle = this.GetNodeAttributeValue(lcValidation, "errorStyle")
DO CASE
CASE lcValidStyle = "stop"
lnValidStyle = STOP_VALID_STYLE
CASE lcValidStyle = "warning"
lnValidStyle = WARN_VALID_STYLE
CASE lcValidStyle = "information"
lnValidStyle = INFO_VALID_STYLE
OTHERWISE
lnValidStyle = 0
ENDCASE
lcOperator = this.GetNodeAttributeValue(lcValidation, "operator")
DO CASE
CASE lcOperator = "between"
lnOperator = BETWEEN_VALID_OPER
CASE lcOperator = "notBetween"
lnOperator = NOTBETW_VALID_OPER
CASE lcOperator = "equal"
lnOperator = EQUAL_VALID_OPER
CASE lcOperator = "notEqual"
lnOperator = NOTEQUAL_VALID_OPER
CASE lcOperator = "lessThan"
lnOperator = LESSTHAN_VALID_OPER
CASE lcOperator = "lessThanOrEqual"
lnOperator = LESSOREQUAL_VALID_OPER
CASE lcOperator = "greaterThan"
lnOperator = GREATTHAN_VALID_OPER
CASE lcOperator = "greaterThanOrEqual"
lnOperator = GREATOREQUAL_VALID_OPER
OTHERWISE
lnOperator = 0
ENDCASE
lcErrMsg = this.GetNodeAttributeValue(lcValidation, "error")
lcErrTitle = this.GetNodeAttributeValue(lcValidation, "errorTitle")
lcPrompt = this.GetNodeAttributeValue(lcValidation, "prompt")
llAllowBlank = IIF(CAST(this.GetNodeAttributeValue(lcValidation, "allowBlank") AS I)=1, True, False)
llShowInputMsg = IIF(CAST(this.GetNodeAttributeValue(lcValidation, "showInputMessage") AS I)=1, True, False)
llShowErrMsg = IIF(CAST(this.GetNodeAttributeValue(lcValidation, "showErrorMessage") AS I)=1, True, False)
lcFormula1 = this.GetNodeElementValue(this.GetNodeElement(lcValidation, 'formula1', 1, True))
lcFormula2 = this.GetNodeElementValue(this.GetNodeElement(lcValidation, 'formula2', 1, True))
IF LEFT(lcFormula1, 1) = '"' .OR. LEFT(lcFormula2, 1) = '"'
lcFormula1 = ALLTRIM(lcFormula1, 1, '"')
lcFormula2 = ALLTRIM(lcFormula2, 1, '"')
llFormula = False
ELSE
llFormula = True
ENDIF
INSERT INTO xl_validation (workbook, sheet, vtype, vstyle, voperator, errmsg, errtitle, vprompt, allowblank, showinpmsg, showerrmsg, formula, formula1, formula2) ;
VALUES (tnWB, tnSheet, lnValidType, lnValidStyle, lnOperator, lcErrMsg, lcErrTitle, lcPrompt, llAllowBlank, llShowInputMsg, llShowErrMsg, llFormula, lcFormula1, lcFormula2)
lnIndex = xl_validation.validndx
loCell = this.CellRefAsciiToIndex(lcValidSqRef)
IF this.GetCellRecord(tnWB, tnSheet, loCell.Row, loCell.Column)
REPLACE xl_cells.validndx WITH lnIndex IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, loCell.Row, loCell.Column, DATA_TYPE_NONE, 0, False, -1, lnIndex)
this.SetRowMaxColumn(tnWB, tnSheet, loCell.Row, loCell.Column)
ENDIF
ENDFOR
RETURN True
ENDPROC
PROTECTED PROCEDURE readstylesxml && Reads the styles.xml file for opening a workbook
LPARAMETERS tcFilePath, tnWB
LOCAL lcCellXfs, lnCnt, lcXf, lnIndent, lnWrapTx, lcAlign, lcStyleSheet, lnNode, lnNumFmtId, lnFontId, lnFillId, lnBorderId
LOCAL lcHAlign, lcVAlign, lcNumFmts, lcFonts, lcNumFmt, lcFormatCode, lcFont, lnIndexed, lnFSize, lcFName, llFBold, llFItalic, llStrkthr
LOCAL lcFVPos, lcULine, lnFColor, lnTheme, lnTint, lcColor, lcFills, lcFill, lcPatternFill, lcPatternType, lnFgColor, lnFgIndexed, lcBorder
LOCAL lnBgColor, lnBgIndexed, lcBorders, lcBLeft, lcLStyle, lnLColor, lnLTheme, lnLTint, lnLIndex, lcBRight, lcRStyle, lnRColor, lnRTheme
LOCAL lnRTint, lnRIndex, lcBTop, lcTStyle, lnTColor, lnTTheme, lnTTint, lnTIndex, lcBBottm, lcBStyle, lnBColor, lnBTheme, lnBTint, lnBIndex
LOCAL lnDTint, lnDIndex, lcBDiag, lcDStyle, lnDColor, lnDTheme, lcIndexedColors, lcRgbColor, lcMruColors, lnIdCnt
RAISEEVENT(this, "OnShowStatusMessage", 1, 2)
*-* Open the styles sheet for processing
lcStyleSheet = FILETOSTR(ADDBS(tcFilePath) + "xl\styles.xml")
*-* Retreive the cell format mapping information
lnIdCnt = -1
lcCellXfs = this.GetNodeElement(lcStyleSheet, 'cellXfs', 1)
lnCnt = CAST(this.GetNodeAttributeValue(lcCellXfs, "count") AS I)
FOR lnNode=1 TO lnCnt
lcXf = this.GetNodeElement(lcCellXfs, 'xf', lnNode)
IF EMPTY(lcXf)
SET STEP ON
LOOP
ENDIF
lnIdCnt = lnIdCnt + 1
lcAlign = this.GetNodeElement(lcXf, 'alignment', 1)
lcHAlign = this.GetNodeAttributeValue(lcAlign, "horizontal")
lcVAlign = this.GetNodeAttributeValue(lcAlign, "vertical")
lnNumFmtId = CAST(this.GetNodeAttributeValue(lcXf, "numFmtId") AS I)
lnFontId = CAST(this.GetNodeAttributeValue(lcXf, "fontId") AS I)
lnFillId = CAST(this.GetNodeAttributeValue(lcXf, "fillId") AS I)
lnBorderId = CAST(this.GetNodeAttributeValue(lcXf, "borderId") AS I)
lnIndent = CAST(this.GetNodeAttributeValue(lcAlign, "indent") AS I)
lnWrapTx = CAST(this.GetNodeAttributeValue(lcAlign, "wrapText") AS I)
lnRotation = CAST(this.GetNodeAttributeValue(lcAlign, "textRotation") AS I)
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, rotation) ;
VALUES (tnWB, lnIdCnt, lnNumFmtId, lnFontId, lnFillId, lnBorderId, lcHAlign, lcVAlign, lnIndent, lnWrapTx, lnRotation)
ENDFOR
this.SetLastId(tnWB, lnIdCnt, "xl_cellxfs")
*-* Retreive the number format information
lnIdCnt = -1
lcNumFmts = this.GetNodeElement(lcStyleSheet, 'numFmts', 1)
lnCnt = CAST(this.GetNodeAttributeValue(lcNumFmts, "count") AS I)
FOR lnNode=1 TO lnCnt
lcNumFmt = this.GetNodeElement(lcNumFmts, 'numFmt', lnNode)
IF EMPTY(lcNumFmt)
SET STEP ON
LOOP
ENDIF
lnNumFmtId = CAST(this.GetNodeAttributeValue(lcNumFmt, "numFmtId") AS I)
lcFormatCode = this.GetNodeAttributeValue(lcNumFmt, "formatCode")
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, lnNumFmtId, lcFormatCode, this.GetStringXML(lcFormatCode), False)
ENDFOR
*-* Retreive the font informaton
lnIdCnt = -1
lcFonts = this.GetNodeElement(lcStyleSheet, 'fonts', 1)
lnCnt = CAST(this.GetNodeAttributeValue(lcFonts, "count") AS I)
FOR lnNode=1 TO lnCnt
lcFont = this.GetNodeElement(lcFonts, 'font', lnNode)
IF EMPTY(lcFont)
SET STEP ON
LOOP
ENDIF
lnIdCnt = lnIdCnt + 1
lnFSize = CAST(this.GetNodeAttributeValue(this.GetNodeElement(lcFont, 'sz', 1), "val") AS I)
lnFSize = IIF(lnFSize>0, lnFSize, 10)
lcFName = this.GetNodeAttributeValue(this.GetNodeElement(lcFont, 'name', 1), "val")
llFBold = IIF(ATC("<b/>", lcFont)>0, True, False)
llFItalic = IIF(ATC("<i/>", lcFont)>0, True, False)
llStrkthr = IIF(ATC("<strike/>", lcFont)>0, True, False)
lcFVPos = this.GetNodeAttributeValue(this.GetNodeElement(lcFont, 'vertAlign', 1), "val")
IF ATC("<u/>", lcFont) > 0
lcULine = UNDERLINE_SINGLE
ELSE
lcULine = this.GetNodeAttributeValue(this.GetNodeElement(lcFont, 'u', 1), "val")
lcULine = IIF(EMPTY(lcULine), UNDERLINE_NONE, lcULine)
ENDIF
lcColor = this.GetNodeElement(lcFont, 'color', 1)
lnFColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnTheme = CAST(this.GetNodeAttributeValue(lcColor, "theme") AS I)
lnTint = CAST(this.GetNodeAttributeValue(lcColor, "tint") AS I)
lnIndexed = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
INSERT INTO xl_fonts (workbook, id, fname, fsize, fcolor, fbold, fitalic, uline, strkthr, fvpos, theme, tint, indexed) ;
VALUES (tnWB, lnIdCnt, lcFName, lnFSize, lnFColor, llFBold, llFItalic, lcULine, llStrkthr, lcFVPos, lnTheme, lnTint, lnIndexed)
ENDFOR
this.SetLastId(tnWB, lnIdCnt, "xl_fonts")
*-* Retreive the cell fill information
lnIdCnt = -1
lcFills = this.GetNodeElement(lcStyleSheet, 'fills', 1)
lnCnt = CAST(this.GetNodeAttributeValue(lcFills, "count") AS I)
FOR lnNode=1 TO lnCnt
lcFill = this.GetNodeElement(lcFills, 'fill', lnNode)
IF EMPTY(lcFill)
SET STEP ON
LOOP
ENDIF
lnIdCnt = lnIdCnt + 1
lcPatternFill = this.GetNodeElement(lcFill, 'patternFill', 1)
lcPatternType = this.GetNodeAttributeValue(lcPatternFill, "patternType")
lcPatternType = IIF(EMPTY(lcPatternType), "none", lcPatternType)
lnTheme = CAST(this.GetNodeAttributeValue(lcPatternFill, "theme") AS I)
lcColor = this.GetNodeElement(lcPatternFill, 'fgColor', 1)
IF EMPTY(lcColor)
lnFgColor = 0
lnFgIndexed = 0
ELSE
lnFgColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnFgIndexed = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
ENDIF
lcColor = this.GetNodeElement(lcPatternFill, 'bgColor', 1)
IF EMPTY(lcColor)
lnBgColor = 0
lnBgIndexed = 0
ELSE
lnBgColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnBgIndexed = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
ENDIF
INSERT INTO xl_fills (workbook, id, patttype, theme, tint, fgcolor, bgcolor, fgindexed, bgindexed) ;
VALUES (tnWB, lnIdCnt, lcPatternType, lnTheme, lnTint, lnFgColor, lnBgColor, lnFgIndexed, lnBgIndexed)
ENDFOR
this.SetLastId(tnWB, lnIdCnt, "xl_fills")
*-* Retreive the cell border information
lnIdCnt = -1
lcBorders = this.GetNodeElement(lcStyleSheet, 'borders', 1)
lnCnt = CAST(this.GetNodeAttributeValue(lcBorders, "count") AS I)
FOR lnNode=1 TO lnCnt
lcBorder = this.GetNodeElement(lcBorders, 'border', lnNode)
IF EMPTY(lcBorder)
SET STEP ON
LOOP
ENDIF
lnIdCnt = lnIdCnt + 1
lcBLeft = this.GetNodeElement(lcBorder, 'left', 1)
lcLStyle = this.GetNodeAttributeValue(lcBLeft, "style")
lcColor = this.GetNodeElement(lcBLeft, 'color', 1)
IF EMPTY(lcColor)
lnLColor = RGB(0, 0, 0)
lnLTheme = 0
lnLTint = 0
lnLIndex = 0
ELSE
lnLColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnLTheme = CAST(this.GetNodeAttributeValue(lcColor, "theme") AS I)
lnLTint = CAST(this.GetNodeAttributeValue(lcColor, "tint") AS I)
lnLIndex = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
ENDIF
lcBRight = this.GetNodeElement(lcBorder, 'right', 1)
lcRStyle = this.GetNodeAttributeValue(lcBRight, "style")
lcColor = this.GetNodeElement(lcBRight, 'color', 1)
IF EMPTY(lcColor)
lnRColor = RGB(0, 0, 0)
lnRTheme = 0
lnRTint = 0
lnRIndex = 0
ELSE
lnRColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnRTheme = CAST(this.GetNodeAttributeValue(lcColor, "theme") AS I)
lnRTint = CAST(this.GetNodeAttributeValue(lcColor, "tint") AS I)
lnRIndex = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
ENDIF
lcBTop = this.GetNodeElement(lcBorder, 'top', 1)
lcTStyle = this.GetNodeAttributeValue(lcBTop, "style")
lcColor = this.GetNodeElement(lcBTop, 'color', 1)
IF EMPTY(lcColor)
lnTColor = RGB(0, 0, 0)
lnTTheme = 0
lnTTint = 0
lnTIndex = 0
ELSE
lnTColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnTTheme = CAST(this.GetNodeAttributeValue(lcColor, "theme") AS I)
lnTTint = CAST(this.GetNodeAttributeValue(lcColor, "tint") AS I)
lnTIndex = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
ENDIF
lcBBottm = this.GetNodeElement(lcBorder, 'bottom', 1)
lcBStyle = this.GetNodeAttributeValue(lcBBottm, "style")
lcColor = this.GetNodeElement(lcBBottm, 'color', 1)
IF EMPTY(lcColor)
lnBColor = RGB(0, 0, 0)
lnBTheme = 0
lnBTint = 0
lnBIndex = 0
ELSE
lnBColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnBTheme = CAST(this.GetNodeAttributeValue(lcColor, "theme") AS I)
lnBTint = CAST(this.GetNodeAttributeValue(lcColor, "tint") AS I)
lnBIndex = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
ENDIF
lcBDiag = this.GetNodeElement(lcBorder, 'diagonal', 1)
lcDStyle = this.GetNodeAttributeValue(lcBDiag, "style")
lnDiagDn = CAST(this.GetNodeAttributeValue(lcBDiag, "diagonalDown") AS I)
lnDiagUp = CAST(this.GetNodeAttributeValue(lcBDiag, "diagonalUp") AS I)
lcColor = CAST(this.GetNodeElement(lcBDiag, 'color', 1) AS I)
IF EMPTY(lcColor)
lnDColor = RGB(0, 0, 0)
lnDTheme = 0
lnDTint = 0
lnDIndex = 0
ELSE
lnDColor = this.ConvertHexStringToNumeric(this.GetNodeAttributeValue(lcColor, "rgb"))
lnDTheme = CAST(this.GetNodeAttributeValue(lcColor, "theme") AS I)
lnDTint = CAST(this.GetNodeAttributeValue(lcColor, "tint") AS I)
lnDIndex = CAST(this.GetNodeAttributeValue(lcColor, "indexed") AS I)
ENDIF
INSERT INTO xl_borders (workbook, id, lstyle, lcolor, ltheme, ltint, lindexed, rstyle, rcolor, rtheme, rtint, rindexed, tstyle, tcolor, ttheme, ttint, tindexed, ;
bstyle, bcolor, btheme, btint, bindexed, dstyle, dcolor, dtheme, dtint, dindexed, diagdn, diagup) ;
VALUES (tnWB, lnIdCnt, lcLStyle, lnLColor, lnLTheme, lnLTint, lnLIndex, lcRStyle, lnRColor, lnRTheme, lnRTint, lnRIndex, lcTStyle, lnTColor, lnTTheme, ;
lnTTint, lnTIndex, lcBStyle, lnBColor, lnBTheme, lnBTint, lnBIndex, lcDStyle, lnDColor, lnDTheme, lnDTint, lnDIndex, lnDiagDn, lnDiagUp)
ENDFOR
this.SetLastId(tnWB, lnIdCnt, "xl_borders")
*-* Retreive the indexed color information
lcColors = this.GetNodeElement(lcStyleSheet, 'colors', 1)
IF !EMPTY(lcColors)
lcIndexedColors = this.GetNodeElement(lcColors, 'indexedColors', 1)
IF !EMPTY(lcIndexedColors)
lnNode = 1
lcRgbColor = this.GetNodeElement(lcIndexedColors, 'rgbColor', lnNode)
DO WHILE !EMPTY(lcRgbColor)
lcHexColor = this.GetNodeAttributeValue(lcRgbColor, "rgb")
INSERT INTO xl_ndxcolors (workbook, indexid, rgbcolor) VALUES (tnWB, lnNode, lcHexColor)
lnNode = lnNode + 1
lcRgbColor = this.GetNodeElement(lcIndexedColors, 'rgbColor', lnNode)
ENDDO
this.SetLastId(tnWB, lnNode-1, "xl_ndxcolors")
ENDIF
lcMruColors = this.GetNodeElement(lcColors, 'mruColors', 1)
IF !EMPTY(lcMruColors)
lnNode = 1
lcRgbColor = this.GetNodeElement(lcMruColors, 'color', lnNode)
DO WHILE !EMPTY(lcRgbColor)
lcHexColor = this.GetNodeAttributeValue(lcRgbColor, "rgb")
INSERT INTO xl_mrucolors (workbook, indexid, rgbcolor) VALUES (tnWB, lnNode, lcHexColor)
lnNode = lnNode + 1
lcRgbColor = this.GetNodeElement(lcMruColors, 'color', lnNode)
ENDDO
this.SetLastId(tnWB, lnNode-1, "xl_mrucolors")
ENDIF
ENDIF
ENDPROC
PROTECTED PROCEDURE removeworkingdirectories && Removes the working directories
LPARAMETERS tcDir
LOCAL llReturn, loException
TRY
llReturn = IIF(apiRemoveDirectory(tcDir) != 0, True, False)
CATCH TO loException
SET STEP ON
llReturn = False
ENDTRY
RETURN llReturn
ENDPROC
PROCEDURE renamesheet && Renames the selected sheet
LPARAMETERS tnWB, txSheet, tcSheetName
LOCAL llReturn
llReturn = False
DO CASE
CASE VARTYPE(txSheet) = "C"
IF SEEK(BINTOC(tnWB)+UPPER(txSheet), "xl_sheets", "shname")
REPLACE xl_sheets.shname WITH tcSheetName IN xl_sheets
llReturn = True
ENDIF
CASE VARTYPE(txSheet) = "N"
IF SEEK(BINTOC(tnWB)+BINTOC(txSheet), "xl_sheets", "sheetndx")
REPLACE xl_sheets.shname WITH tcSheetName IN xl_sheets
llReturn = True
ENDIF
ENDCASE
RETURN llReturn
ENDPROC
PROCEDURE resetcolumnwidth && Resets the column width to default
LPARAMETERS tnWB, tnSheet, tnColumn
IF SEEK(this.GetColWidthKeyExpr(tnWB, tnSheet, tnColumn), "xl_colwidths", "shcolumn")
DELETE IN xl_colwidths
ENDIF
ENDPROC
PROTECTED PROCEDURE saveasutf8 && Saves the file as a UTF-8
LPARAMETERS tcFileName
STRTOFILE(STRCONV(FILETOSTR(tcFileName), 9), tcFileName, 4)
ENDPROC
PROCEDURE savegridtoworkbook && Saves the selected grid to a workbook
LPARAMETERS toGrid, txWB, tlFreeze, tlSaveWB, tcSheetName, tlInclHiddenCols
LOCAL lcAlias, lnCol, lnWB, lnSh, lnRow, lcField, loReturn, loColumn, lnStyle, lnColCount, lnDefStyle
LOCAL ARRAY laRowCount[1], laColOrder[1]
loReturn = CREATEOBJECT("Empty")
ADDPROPERTY(loReturn, "Workbook", 0)
ADDPROPERTY(loReturn, "Sheet", 0)
DO CASE
CASE PCOUNT() = 0
RETURN loReturn
CASE PCOUNT() = 1
RETURN loReturn
CASE PCOUNT() = 2
tlFreeze = True
tlSaveWB = True
tcSheetName = this.DeriveSheetName(txWB)
tlInclHiddenCols = True
CASE PCOUNT() = 3
tlSaveWB = True
tcSheetName = this.DeriveSheetName(txWB)
tlInclHiddenCols = True
CASE PCOUNT() = 4
tcSheetName = this.DeriveSheetName(txWB)
tlInclHiddenCols = True
CASE PCOUNT() = 5
tlInclHiddenCols = True
ENDCASE
IF VARTYPE(tcSheetName) != 'C' .OR. EMPTY(tcSheetName)
tcSheetName = this.DeriveSheetName(txWB)
ENDIF
tcSheetName = CHRTRAN(tcSheetName, ":\/?*", "_____")
IF LEN(tcSheetName) > LIMITS_MAX_SH_NAME
IF this.AutoTrimSheetName
tcSheetName = LEFT(ALLTRIM(tcSheetName), LIMITS_MAX_SH_NAME)
ELSE
RETURN loReturn
ENDIF
ENDIF
IF VARTYPE(toGrid) != "O" .AND. PEMSTATUS(toGrid, "BaseClass", 5) .AND. LOWER(toGrid.BaseClass) != "grid"
RETURN loReturn
ENDIF
DO CASE
CASE VARTYPE(txWB) = "C"
lnWB = this.CreateWorkbook(txWB)
IF lnWB = 0
lnWB = this.GetWorkbook(txWB)
ENDIF
CASE VARTYPE(txWB) = "N"
IF SEEK(BINTOC(txWB), "xl_workbooks", "workbook")
lnWB = txWB
ELSE
RETURN loReturn
ENDIF
OTHERWISE
RETURN loReturn
ENDCASE
IF lnWB > 0
lnSh = this.AddSheet(lnWB, tcSheetName)
IF lnSh > 0
lcAlias = JUSTSTEM(toGrid.RecordSource)
*-* Get the record count and display a status window
SELECT COUNT(*) FROM &lcAlias INTO ARRAY laRowCount
RAISEEVENT(this, "OnShowStatusMessage", 3, 0, laRowCount[1])
*-* Get the number of columns to process and
*-* Get the column output order based on grid display order && Change requested by Matt Slay to output by grid display order and visible setting
IF tlInclHiddenCols
lnColCount = toGrid.ColumnCount
DIMENSION laColOrder[lnColCount, 2]
FOR lnCol=1 TO toGrid.ColumnCount
laColOrder[lnCol, 1] = toGrid.Columns(lnCol).ColumnOrder && Grid display order
laColOrder[lnCol, 2] = lnCol && Column property order
ENDFOR
ELSE
lnColCount = 0
FOR lnCol=1 TO toGrid.ColumnCount
IF toGrid.Columns(lnCol).Visible
lnColCount = lnColCount + 1
DIMENSION laColOrder[lnColCount, 2]
laColOrder[lnColCount, 1] = toGrid.Columns(lnCol).ColumnOrder && Grid display order
laColOrder[lnColCount, 2] = lnCol && Column property order
ENDIF
ENDFOR
ENDIF
IF lnColCount = 0
RETURN False
ENDIF
ASORT(laColOrder)
*-* Add the header row if defined and set the column widths; get the column font info
IF toGrid.HeaderHeight > 0 && Change recommendation by Doug Hennig (if no headers, start in first row)
lnRow = 1
FOR lnCol=1 TO lnColCount
loColumn = toGrid.Columns(laColOrder[lnCol, 2])
this.SetCellValue(lnWB, lnSh, 1, lnCol, loColumn.Header1.Caption)
this.SetColumnWidth(lnWB, lnSh, lnCol, this.ConvertPixelsToExcelUnits(loColumn.Width))
ENDFOR
ELSE
lnRow = 0
FOR lnCol=1 TO lnColCount
loColumn = toGrid.Columns(laColOrder[lnCol, 2])
this.SetColumnWidth(lnWB, lnSh, lnCol, this.ConvertPixelsToExcelUnits(loColumn.Width))
ENDFOR
ENDIF
*-* Add the cell data values
SELECT &lcAlias
SCAN
lnRow = lnRow + 1
RAISEEVENT(this, "OnShowStatusMessage", 3, lnRow)
FOR lnCol=1 TO lnColCount
loColumn = toGrid.Columns(laColOrder[lnCol, 2])
lcField = loColumn.ControlSource
this.SetCellValue(lnWB, lnSh, lnRow, lnCol, &lcField)
ENDFOR
ENDSCAN
*-* Set the cell style formatting
lnDefStyle = this.IsFormatStyleDefined(lnWB, this.DefaultFont, this.DefaultFontSize)
IF ISNULL(lnDefStyle)
lnDefStyle = this.CreateFormatStyle(lnWB)
this.AddStyleFont(lnWB, lnDefStyle, this.DefaultFont, this.DefaultFontSize)
ENDIF
FOR lnCol=1 TO lnColCount
loColumn = toGrid.Columns(laColOrder[lnCol, 2])
lcField = loColumn.ControlSource
IF VARTYPE(&lcField) != DATA_TYPE_DATE
IF this.DefaultFont != loColumn.FontName .OR. this.DefaultFontSize != loColumn.FontSize && Change recommended by Doug Hennig; 2017-06-12
lnStyle = this.IsFormatStyleDefined(lnWB, loColumn.FontName, loColumn.FontSize)
IF ISNULL(lnStyle)
lnStyle = this.CreateFormatStyle(lnWB)
this.AddStyleFont(lnWB, lnStyle, loColumn.FontName, loColumn.FontSize)
ENDIF
ELSE
lnStyle = lnDefStyle
ENDIF
this.SetCellStyleRange(lnWB, lnSh, 1, lnCol, laRowCount[1]+1, lnCol, lnStyle)
ENDIF
ENDFOR
*-* Freeze the first row if specified
IF tlFreeze
this.FreezePanes(lnWB, lnSh, 1, 0)
ENDIF
RAISEEVENT(this, "OnShowStatusMessage", 3, -1)
IF tlSaveWB
this.SaveWorkbook(lnWB)
ENDIF
loReturn.Sheet = lnSh
loReturn.Workbook = lnWB
ENDIF
ENDIF
RETURN loReturn
ENDPROC
PROCEDURE savegridtoworkbookex && Saves the passed grid to a workbook without adding the content to the internal cursors
LPARAMETERS toGrid, tcFileName, tlFreeze, tcSheetName, tlInclHiddenCols
LOCAL llError, lcTempPath, lcAlias, lcFileName, lhFile, lcRowDefHt, lnCol, lnRow, lcSETCentury, lxCellValue
LOCAL lnColCount, lnColWidth, lcCurAlias
LOCAL ARRAY laColOrder[1], laSheetNames[1]
llError = False
lcCurAlias = ALIAS()
IF VARTYPE(toGrid) != "O" .AND. PEMSTATUS(toGrid, "BaseClass", 5) .AND. LOWER(toGrid.BaseClass) != "grid"
RETURN False
ENDIF
DO CASE
CASE PCOUNT() < 2
RETURN False
CASE PCOUNT() = 2
tlFreeze = True
tcSheetName = toGrid.Name
tlInclHiddenCols = True
CASE PCOUNT() = 3
tcSheetName = toGrid.Name
tlInclHiddenCols = True
CASE PCOUNT() = 4
tlInclHiddenCols = True
ENDCASE
IF VARTYPE(tcSheetName) != 'C' .OR. EMPTY(tcSheetName)
tcSheetName = toGrid.Name
ENDIF
tcSheetName = CHRTRAN(tcSheetName, ":\/?*", "_____")
IF LEN(tcSheetName) > LIMITS_MAX_SH_NAME
IF this.AutoTrimSheetName
tcSheetName = LEFT(ALLTRIM(tcSheetName), LIMITS_MAX_SH_NAME)
ELSE
RETURN False
ENDIF
ENDIF
*-* Set temporary output path
lcTempPath = this.CreateWorkingDirectories()
IF ISNULL(lcTempPath)
RETURN False
ENDIF
*-* Save current settings and then set to US formats
lcSetPoint = SET("POINT")
lcSeparator = SET("SEPARATOR")
IF lcSetPoint != "."
SET POINT TO "."
SET SEPARATOR TO ","
ENDIF
*-* Output the workbook
lcAlias = JUSTSTEM(toGrid.RecordSource)
*-* Get the number of columns to process
*-* Get the column output order based on grid display order && Change requested by Matt Slay to output by grid display order and visible setting
IF tlInclHiddenCols
lnColCount = toGrid.ColumnCount
DIMENSION laColOrder[lnColCount, 2]
FOR lnCol=1 TO toGrid.ColumnCount
laColOrder[lnCol, 1] = toGrid.Columns(lnCol).ColumnOrder && Grid display order
laColOrder[lnCol, 2] = lnCol && Column property order
ENDFOR
ELSE
lnColCount = 0
FOR lnCol=1 TO toGrid.ColumnCount
IF toGrid.Columns(lnCol).Visible
lnColCount = lnColCount + 1
DIMENSION laColOrder[lnColCount, 2]
laColOrder[lnColCount, 1] = toGrid.Columns(lnCol).ColumnOrder && Grid display order
laColOrder[lnColCount, 2] = lnCol && Column property order
ENDIF
ENDFOR
ENDIF
IF lnColCount = 0
RETURN False
ENDIF
ASORT(laColOrder)
DIMENSION laSheetNames[1]
laSheetNames[1] = tcSheetName
IF this.WriteDirectXMLs(lcTempPath, @laSheetNames)
*-* Write the sheet XML
TRY
lcFileName = lcTempPath + "xl\worksheets\sheet1.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
*-* Write sheet XML header information
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"')
FWRITE(lhFile, ' xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships"')
FWRITE(lhFile, ' xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac"')
FWRITE(lhFile, ' xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">')
*-* Write the sheet view information which includes the freeze pane information
FWRITE(lhFile, '<dimension ref="A1:' + this.ColumnIndexToAscii(lnColCount) + TRANSFORM(RECCOUNT(lcAlias)+1) + '"/>')
IF tlFreeze
FWRITE(lhFile, '<sheetViews><sheetView workbookViewId="0">')
FWRITE(lhFile, '<pane state="frozenSplit" activePane="bottomLeft" topLeftCell="A2" ySplit="1"/>')
FWRITE(lhFile, '<selection activeCell="A2" sqref="A2" pane="bottomLeft"/>')
FWRITE(lhFile, '</sheetView></sheetViews>')
ENDIF
FWRITE(lhFile, '<sheetFormatPr defaultRowHeight="15"/>')
*-* Write sheet Column widths
FWRITE(lhFile, '<cols>')
FOR lnCol=1 TO lnColCount
lnColWidth = this.ConvertPixelsToExcelUnits(toGrid.Columns(laColOrder[lnCol, 2]).Width)
FWRITE(lhFile, '<col min="' + TRANSFORM(lnCol) + '" max="' + TRANSFORM(lnCol) + '" width="' + TRANSFORM(lnColWidth+0.7109375) + '" customWidth="1"/>')
ENDFOR
FWRITE(lhFile, '</cols>')
*-* Write sheet cell data values
lcRowDefHt = ' ht="30"'
FWRITE(lhFile, '<sheetData>')
*-* Place field names in the first row
IF toGrid.HeaderHeight > 0 && Change recommendation by Doug Hennig (if no headers, then no output)
FWRITE(lhFile, '<row r="1" spans="1:' + TRANSFORM(lnColCount) + '"' + lcRowDefHt + '>')
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
FOR lnCol=1 TO lnColCount
this.WriteAsInLineString(lhFile, 1, lnCol, toGrid.Columns(laColOrder[lnCol, 2]).Header1.Caption)
ENDFOR
ELSE
FOR lnCol=1 TO lnColCount
this.WriteAsInLineFormattedString(lhFile, 1, lnCol, toGrid.Columns(laColOrder[lnCol, 2]).Header1.Caption)
ENDFOR
ENDIF
FWRITE(lhFile, '</row>')
lnRow = 1
ELSE
lnRow = 0
ENDIF
*-* Write the grid field values to cells
lcSETCentury = SET("CENTURY")
SET CENTURY ON
SELECT &lcAlias
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '<row r="' + TRANSFORM(lnRow) + '" spans="1:' + TRANSFORM(lnColCount) + '"' + lcRowDefHt + '>')
FOR lnCol=1 TO lnColCount
lxCellValue = EVALUATE(toGrid.Columns(laColOrder[lnCol, 2]).ControlSource)
this.WriteDirectCellValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '</row>')
ENDSCAN
ELSE
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '<row r="' + TRANSFORM(lnRow) + '" spans="1:' + TRANSFORM(lnColCount) + '"' + lcRowDefHt + '>')
FOR lnCol=1 TO lnColCount
lxCellValue = EVALUATE(toGrid.Columns(laColOrder[lnCol, 2]).ControlSource)
this.WriteDirectCellFormattedValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '</row>')
ENDSCAN
ENDIF
SET CENTURY &lcSETCentury
*-* End the sheet cell data values and worksheet
FWRITE(lhFile, '</sheetData>')
FWRITE(lhFile, '<pageMargins left="0.7" right="0.7" top="0.75" bottom="0.75" header="0.3" footer="0.3"/>')
FWRITE(lhFile, '</worksheet>')
CATCH TO loException
SET STEP ON
llError = True
this.ErrorLevelId = 14
RAISEEVENT(this, "OnShowErrorMessage", 14, loException.message)
FINALLY
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
ENDTRY
IF llError
llSuccess = False
ELSE
llSuccess = this.CreateExcelFile(lcTempPath, JUSTPATH(tcFileName), JUSTSTEM(tcFileName)) && Change recommendation by Doug Hennig [placement of code after ELSE]
ENDIF
this.RemoveWorkingDirectories(lcTempPath)
ELSE
llSuccess = False
ENDIF
IF !EMPTY(lcCurAlias)
SELECT (lcCurAlias)
ENDIF
*-* Restore default settings
IF lcSetPoint != "."
SET POINT TO (lcSetPoint)
SET SEPARATOR TO (lcSeparator)
ENDIF
RETURN llSuccess
ENDPROC
PROCEDURE savemultigridtoworkbookex && Same as SaveGridToWorkbookEx() method but handles multiple grids being passed
LPARAMETERS toGrids, tcFileName
LOCAL llError, lcTempPath, lcAlias, lcFileName, lhFile, lcRowDefHt, lnCol, lnRow, lcSETCentury, lxCellValue
LOCAL lnColCount, lnColWidth, lcCurAlias, lnGrid, loGrid, loException, lcSheetName
LOCAL ARRAY laColOrder[1], laSheetNames[1]
llError = False
lcCurAlias = ALIAS()
IF PCOUNT() < 2
RETURN False
ENDIF
IF VARTYPE(toGrids) = "O"
IF PEMSTATUS(toGrids, "Count", 5) .AND. VARTYPE(toGrids.Count) != "N"
RETURN False
ELSE
IF toGrids.Count < 1
RETURN False
ENDIF
ENDIF
IF PEMSTATUS(toGrids, "List", 5)
llError = False
TRY
IF ALEN(toGrids.List, 2) != 4 && Column 1 Grid; Column 2 SheetName; Column 3 Freeze indicator, Column 4 HiddenCols indicator
THROW
ENDIF
CATCH TO loException
llError = True
ENDTRY
IF llError
RETURN False
ENDIF
FOR lnGrid=1 TO toGrids.Count
*-* Validate grid object
loGrid = toGrids.List[lnGrid, 1]
IF VARTYPE(loGrid) != "O" .AND. PEMSTATUS(loGrid, "BaseClass", 5) .AND. LOWER(loGrid.BaseClass) != "grid"
RETURN False
ENDIF
*-* Validate sheet name
lcSheetName = toGrids.List[lnGrid, 2]
IF VARTYPE(lcSheetName) != 'C' .OR. EMPTY(lcSheetName)
lcSheetName = loGrid.Name
ENDIF
lcSheetName = CHRTRAN(lcSheetName, ":\/?*", "_____")
IF LEN(lcSheetName) > LIMITS_MAX_SH_NAME
IF this.AutoTrimSheetName
lcSheetName = LEFT(ALLTRIM(lcSheetName), LIMITS_MAX_SH_NAME)
ELSE
RETURN False
ENDIF
ENDIF
toGrids.List[lnGrid, 2] = lcSheetName
*-* Validate freeze indicator
IF VARTYPE(toGrids.List[lnGrid, 3]) != 'L'
toGrids.List[lnGrid, 3] = False
ENDIF
*-* Validate hidden column indicator
IF VARTYPE(toGrids.List[lnGrid, 4]) != 'L'
toGrids.List[lnGrid, 4] = False
ENDIF
ENDFOR
ENDIF
ELSE
RETURN False
ENDIF
*-* Set temporary output path
lcTempPath = this.CreateWorkingDirectories()
IF ISNULL(lcTempPath)
RETURN False
ENDIF
*-* Save current settings and then set to US formats
lcSetPoint = SET("POINT")
lcSeparator = SET("SEPARATOR")
IF lcSetPoint != "."
SET POINT TO "."
SET SEPARATOR TO ","
ENDIF
*-* Output the workbook
DIMENSION laSheetNames[toGrids.Count]
FOR lnGrid=1 TO toGrids.Count
laSheetNames[lnGrid] = toGrids.List[lnGrid, 2]
ENDFOR
IF !this.WriteDirectXMLs(lcTempPath, @laSheetNames)
RETURN False
ENDIF
*-* Write the sheet xml for each grid
FOR lnGrid=1 TO toGrids.Count
loGrid = toGrids.List[lnGrid, 1]
lcAlias = JUSTSTEM(loGrid.RecordSource)
*-* Get the number of columns to process
*-* Get the column output order based on grid display order && Change requested by Matt Slay to output by grid display order and visible setting
IF toGrids.List[lnGrid, 4]
lnColCount = loGrid.ColumnCount
DIMENSION laColOrder[lnColCount, 2]
FOR lnCol=1 TO loGrid.ColumnCount
laColOrder[lnCol, 1] = loGrid.Columns(lnCol).ColumnOrder && Grid display order
laColOrder[lnCol, 2] = lnCol && Column property order
ENDFOR
ELSE
lnColCount = 0
FOR lnCol=1 TO loGrid.ColumnCount
IF loGrid.Columns(lnCol).Visible
lnColCount = lnColCount + 1
DIMENSION laColOrder[lnColCount, 2]
laColOrder[lnColCount, 1] = loGrid.Columns(lnCol).ColumnOrder && Grid display order
laColOrder[lnColCount, 2] = lnCol && Column property order
ENDIF
ENDFOR
ENDIF
IF lnColCount = 0
RETURN False
ENDIF
ASORT(laColOrder)
TRY
lcFileName = lcTempPath + "xl\worksheets\sheet" + TRANSFORM(lnGrid) + ".xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
*-* Write sheet XML header information
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"')
FWRITE(lhFile, ' xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships"')
FWRITE(lhFile, ' xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac"')
FWRITE(lhFile, ' xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">')
*-* Write the sheet view information which includes the freeze pane information
FWRITE(lhFile, '<dimension ref="A1:' + this.ColumnIndexToAscii(lnColCount) + TRANSFORM(RECCOUNT(lcAlias)+1) + '"/>')
IF toGrids.List[lnGrid, 3]
FWRITE(lhFile, '<sheetViews><sheetView workbookViewId="0">')
FWRITE(lhFile, '<pane state="frozenSplit" activePane="bottomLeft" topLeftCell="A2" ySplit="1"/>')
FWRITE(lhFile, '<selection activeCell="A2" sqref="A2" pane="bottomLeft"/>')
FWRITE(lhFile, '</sheetView></sheetViews>')
ENDIF
FWRITE(lhFile, '<sheetFormatPr defaultRowHeight="15"/>')
*-* Write sheet Column widths
FWRITE(lhFile, '<cols>')
FOR lnCol=1 TO lnColCount
lnColWidth = this.ConvertPixelsToExcelUnits(loGrid.Columns(laColOrder[lnCol, 2]).Width)
FWRITE(lhFile, '<col min="' + TRANSFORM(lnCol) + '" max="' + TRANSFORM(lnCol) + '" width="' + TRANSFORM(lnColWidth+0.7109375) + '" customWidth="1"/>')
ENDFOR
FWRITE(lhFile, '</cols>')
*-* Write sheet cell data values
lcRowDefHt = ' ht="30"'
FWRITE(lhFile, '<sheetData>')
*-* Place field names in the first row
IF loGrid.HeaderHeight > 0 && Change recommendation by Doug Hennig (if no headers, then no output)
FWRITE(lhFile, '<row r="1" spans="1:' + TRANSFORM(lnColCount) + '"' + lcRowDefHt + '>')
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
FOR lnCol=1 TO lnColCount
this.WriteAsInLineString(lhFile, 1, lnCol, loGrid.Columns(laColOrder[lnCol, 2]).Header1.Caption)
ENDFOR
ELSE
FOR lnCol=1 TO lnColCount
this.WriteAsInLineFormattedString(lhFile, 1, lnCol, loGrid.Columns(laColOrder[lnCol, 2]).Header1.Caption)
ENDFOR
ENDIF
FWRITE(lhFile, '</row>')
lnRow = 1
ELSE
lnRow = 0
ENDIF
*-* Write the grid field values to cells
lcSETCentury = SET("CENTURY")
SET CENTURY ON
SELECT &lcAlias
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '<row r="' + TRANSFORM(lnRow) + '" spans="1:' + TRANSFORM(lnColCount) + '"' + lcRowDefHt + '>')
FOR lnCol=1 TO lnColCount
lxCellValue = EVALUATE(loGrid.Columns(laColOrder[lnCol, 2]).ControlSource)
this.WriteDirectCellValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '</row>')
ENDSCAN
ELSE
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '<row r="' + TRANSFORM(lnRow) + '" spans="1:' + TRANSFORM(lnColCount) + '"' + lcRowDefHt + '>')
FOR lnCol=1 TO lnColCount
lxCellValue = EVALUATE(loGrid.Columns(laColOrder[lnCol, 2]).ControlSource)
this.WriteDirectCellFormattedValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '</row>')
ENDSCAN
ENDIF
SET CENTURY &lcSETCentury
*-* End the sheet cell data values and worksheet
FWRITE(lhFile, '</sheetData>')
FWRITE(lhFile, '<pageMargins left="0.7" right="0.7" top="0.75" bottom="0.75" header="0.3" footer="0.3"/>')
FWRITE(lhFile, '</worksheet>')
CATCH TO loException
SET STEP ON
llError = True
this.ErrorLevelId = 14
RAISEEVENT(this, "OnShowErrorMessage", 14, loException.message)
FINALLY
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
ENDTRY
ENDFOR
IF llError
llSuccess = False
ELSE
llSuccess = this.CreateExcelFile(lcTempPath, JUSTPATH(tcFileName), JUSTSTEM(tcFileName)) && Change recommendation by Doug Hennig [placement of code after ELSE]
ENDIF
*-* Cleanup
this.RemoveWorkingDirectories(lcTempPath)
IF !EMPTY(lcCurAlias)
SELECT (lcCurAlias)
ENDIF
*-* Restore default settings
IF lcSetPoint != "."
SET POINT TO (lcSetPoint)
SET SEPARATOR TO (lcSeparator)
ENDIF
RETURN llSuccess
ENDPROC
PROCEDURE savetabletoworkbook && Saves the table passed (alias) as a workbook sheet
LPARAMETERS tcAlias, tnWB, tlFreeze, tlSaveWB, tcSheetName
LOCAL lcAlias, lnCol, lnWB, lnSh, lnRow, lcField, lnFldCnt, llError, llOpenedTbl, loException, lcCurAlias, loReturn
LOCAL lnNdx, lcCaption
LOCAL ARRAY laFields[1], laRowCount[1]
loReturn = CREATEOBJECT("Empty")
ADDPROPERTY(loReturn, "Workbook", 0)
ADDPROPERTY(loReturn, "Sheet", 0)
DO CASE
CASE PCOUNT() < 2
RETURN loReturn
CASE PCOUNT() = 2
tlFreeze = True
tlSaveWB = False
tcSheetName = JUSTSTEM(tcAlias)
CASE PCOUNT() = 3
tlSaveWB = False
tcSheetName = JUSTSTEM(tcAlias)
CASE PCOUNT() = 4
tcSheetName = JUSTSTEM(tcAlias)
ENDCASE
IF VARTYPE(tcSheetName) != 'C' .OR. EMPTY(tcSheetName)
tcSheetName = this.DeriveSheetName(tnWB)
ENDIF
tcSheetName = CHRTRAN(tcSheetName, ":\/?*", "_____")
IF LEN(tcSheetName) > LIMITS_MAX_SH_NAME
IF this.AutoTrimSheetName
tcSheetName = LEFT(ALLTRIM(tcSheetName), LIMITS_MAX_SH_NAME)
ELSE
RETURN loReturn
ENDIF
ENDIF
DO CASE
CASE USED(tcAlias)
lcCurAlias = ALIAS()
llOpenedTbl = False
lcAlias = tcAlias
CASE OCCURS("\", tcAlias) > 0
TRY
lcAlias = JUSTSTEM(tcAlias)
USE (tcAlias) IN 0 ALIAS (lcAlias) SHARED
llOpenedTbl = True
CATCH TO loException
llError = True
ENDTRY
IF llError
RETURN loReturn
ENDIF
OTHERWISE
RETURN loReturn
ENDCASE
DO CASE
CASE VARTYPE(tnWB) = "C"
lnWB = this.CreateWorkbook(tnWB)
IF lnWB = 0
lnWB = this.GetWorkbook(tnWB)
ENDIF
CASE VARTYPE(tnWB) = "N"
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
lnWB = tnWB
ELSE
RETURN loReturn
ENDIF
OTHERWISE
RETURN loReturn
ENDCASE
IF lnWB > 0
lnSh = this.AddSheet(lnWB, tcSheetName)
IF lnSh > 0
*-* Get the record count and display a status window
SELECT COUNT(*) FROM &lcAlias INTO ARRAY laRowCount
RAISEEVENT(this, "OnShowStatusMessage", 3, 0, laRowCount[1])
SELECT &lcAlias
lnFldCnt = AFIELDS(laFields, lcAlias)
FOR lnNdx=1 TO lnFldCnt
TRY
lcCaption = DBGETPROP(lcAlias + "." + laFields[lnNdx, 1], "FIELD", "CAPTION")
laFields[lnNdx, 3] = IIF(EMPTY(lcCaption), laFields[lnNdx, 1], lcCaption)
CATCH TO loException
laFields[lnNdx, 3] = laFields[lnNdx, 1]
ENDTRY
ENDFOR
*-* Place field names in the first row
FOR lnCol=1 TO lnFldCnt
this.SetCellValue(lnWb, lnSh, 1, lnCol, laFields[lnCol, 3])
ENDFOR
*-* Populate next rows with data
lnRow = 0
SCAN
lnRow = lnRow + 1
RAISEEVENT(this, "OnShowStatusMessage", 3, lnRow)
FOR lnCol=1 TO lnFldCnt
IF laFields[lnCol, 2] = "G"
this.SetCellValue(lnWb, lnSh, 1 + lnRow, lnCol, "General")
ELSE
this.SetCellValue(lnWb, lnSh, 1 + lnRow, lnCol, EVALUATE(lcAlias + '.' + laFields[lnCol, 1]))
ENDIF
ENDFOR
ENDSCAN
IF tlFreeze
this.FreezePanes(lnWB, lnSh, 1, 0)
ENDIF
RAISEEVENT(this, "OnShowStatusMessage", 3, -1)
IF tlSaveWB
this.SaveWorkbook(lnWB)
ENDIF
ELSE
lnWB = 0
lnSh = 0
ENDIF
ELSE
lnSh = 0
lnWB = 0
ENDIF
IF llOpenedTbl
USE IN &lcAlias
ELSE
lnSh = 0
lnWB = 0
IF !EMPTY(lcCurAlias)
SELECT &lcCurAlias
ENDIF
ENDIF
loReturn.Sheet = lnSh
loReturn.Workbook = lnWB
RETURN loReturn
ENDPROC
PROCEDURE savetabletoworkbookex && Creates a new workbook from a table; direct write to XLSX file without loading internal cursors
LPARAMETERS tcAlias, tcXlsxName, taFields, tlFreeze, tcSheetName
LOCAL lcCurAlias, llOpenedTbl, lcAlias, llError, loException, lhFile, lnCol, lcRowDefHt
LOCAL lnFldCnt, lnRow, lxCellValue, lcTempPath, lcFileName, lcSETCentry, lcCaption, llSuccess, lcSetPoint
LOCAL lcSeparator
LOCAL ARRAY laSheetNames[1]
EXTERNAL ARRAY taFields
llError = False
DO CASE
CASE PCOUNT() < 2
RETURN False
CASE PCOUNT() = 2
DIMENSION taFields[1, 2]
taFields[1, 1] = .NULL.
tlFreeze = True
tcSheetName = JUSTSTEM(tcAlias)
CASE PCOUNT() = 3
tlFreeze = True
tcSheetName = JUSTSTEM(tcAlias)
CASE PCOUNT() = 4
tcSheetName = JUSTSTEM(tcAlias)
ENDCASE
IF VARTYPE(tcSheetName) != 'C' .OR. EMPTY(tcSheetName)
tcSheetName = JUSTSTEM(tcAlias)
ENDIF
tcSheetName = CHRTRAN(tcSheetName, ":\/?*", "_____")
IF LEN(tcSheetName) > LIMITS_MAX_SH_NAME
IF this.AutoTrimSheetName
tcSheetName = LEFT(ALLTRIM(tcSheetName), LIMITS_MAX_SH_NAME)
ELSE
RETURN False
ENDIF
ENDIF
lcCurAlias = ALIAS()
lcAlias = JUSTSTEM(tcAlias)
DO CASE
CASE USED(lcAlias)
llOpenedTbl = False
CASE OCCURS("\", tcAlias) > 0
TRY
USE (tcAlias) IN 0 ALIAS (lcAlias) SHARED
llOpenedTbl = True
CATCH TO loException
llError = True
ENDTRY
IF llError
RETURN False
ENDIF
OTHERWISE
RETURN False
ENDCASE
*-* Get the table fields to export if not passed as a parameter
SELECT &lcAlias
IF ISNULL(taFields) .OR. EMPTY(taFields[1])
DIMENSION taFields[1, 5]
taFields = ""
lnFldCnt = AFIELDS(taFields, lcAlias)
FOR lnCol=1 TO lnFldCnt
TRY
lcCaption = DBGETPROP(lcAlias + "." + taFields[lnCol, 1], "FIELD", "CAPTION")
taFields[lnCol, 2] = IIF(EMPTY(lcCaption), taFields[lnCol, 1], lcCaption)
CATCH TO loException
taFields[lnCol, 2] = taFields[lnCol, 1]
ENDTRY
ENDFOR
ELSE
lnFldCnt = ALEN(taFields, 1)
IF ALEN(taFields, 2) < 2 .OR. VARTYPE(taFields[1, 2]) != "C"
RETURN False
ENDIF
ENDIF
*-* Set temporary output path
lcTempPath = this.CreateWorkingDirectories()
IF ISNULL(lcTempPath)
RETURN False
ENDIF
*-* Save current settings and then set to US formats
lcSetPoint = SET("POINT")
lcSeparator = SET("SEPARATOR")
IF lcSetPoint != "."
SET POINT TO "."
SET SEPARATOR TO ","
ENDIF
DIMENSION laSheetNames[1]
laSheetNames[1] = tcSheetName
IF this.WriteDirectXMLs(lcTempPath, @laSheetNames)
*-* Write the sheet XML
TRY
lcFileName = lcTempPath + "xl\worksheets\sheet1.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
*-* Write sheet XML header information
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"')
FWRITE(lhFile, ' xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships"')
FWRITE(lhFile, ' xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac"')
FWRITE(lhFile, ' xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">')
*-* Write the sheet view information which includes the freeze pane information
FWRITE(lhFile, '<dimension ref="A1:' + this.ColumnIndexToAscii(lnFldCnt) + TRANSFORM(RECCOUNT(lcAlias)+1) + '"/>')
IF tlFreeze
FWRITE(lhFile, '<sheetViews><sheetView workbookViewId="0">')
FWRITE(lhFile, '<pane state="frozenSplit" activePane="bottomLeft" topLeftCell="A2" ySplit="1"/>')
FWRITE(lhFile, '<selection activeCell="A2" sqref="A2" pane="bottomLeft"/>')
ENDIF
FWRITE(lhFile, '</sheetView></sheetViews>')
FWRITE(lhFile, '<sheetFormatPr defaultRowHeight="15"/>')
*-* Write sheet cell data values
FWRITE(lhFile, '<sheetData>')
*-* Place field names in the first row
lcRowDefHt = ' ht="30"'
FWRITE(lhFile, '<row r="1" spans="1:' + TRANSFORM(lnFldCnt) + '"' + lcRowDefHt + '>')
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
FOR lnCol=1 TO lnFldCnt
this.WriteAsInLineString(lhFile, 1, lnCol, taFields[lnCol, 2])
ENDFOR
ELSE
FOR lnCol=1 TO lnFldCnt
this.WriteAsInLineFormattedString(lhFile, 1, lnCol, taFields[lnCol, 2])
ENDFOR
ENDIF
FWRITE(lhFile, '</row>')
*-* Write the table field values to cells
lcSETCentry = SET("CENTURY")
SET CENTURY ON
lnRow = 1
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '<row r="' + TRANSFORM(lnRow) + '" spans="1:' + TRANSFORM(lnFldCnt) + '"' + lcRowDefHt + '>')
FOR lnCol=1 TO lnFldCnt
lxCellValue = EVALUATE(lcAlias + '.' + taFields[lnCol, 1])
this.WriteDirectCellValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '</row>')
ENDSCAN
ELSE
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '<row r="' + TRANSFORM(lnRow) + '" spans="1:' + TRANSFORM(lnFldCnt) + '"' + lcRowDefHt + '>')
FOR lnCol=1 TO lnFldCnt
lxCellValue = EVALUATE(lcAlias + '.' + taFields[lnCol, 1])
this.WriteDirectCellFormattedValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '</row>')
ENDSCAN
ENDIF
SET CENTURY &lcSETCentry
*-* End the sheet cell data values and worksheet
FWRITE(lhFile, '</sheetData>')
FWRITE(lhFile, '<pageMargins left="0.7" right="0.7" top="0.75" bottom="0.75" header="0.3" footer="0.3"/>')
FWRITE(lhFile, '</worksheet>')
CATCH TO loException
SET STEP ON
llError = True
this.ErrorLevelId = 14
RAISEEVENT(this, "OnShowErrorMessage", 14, loException.message)
FINALLY
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
ENDTRY
IF llError
llSuccess = False
ELSE
*-* Create the XLSX file
llSuccess = this.CreateExcelFile(lcTempPath, JUSTPATH(tcXlsxName), JUSTSTEM(tcXlsxName)) && Change recommendation by Doug Hennig [placement of code after ELSE]
ENDIF
this.RemoveWorkingDirectories(lcTempPath)
ELSE
llSuccess = False
ENDIF
IF !EMPTY(lcCurAlias)
SELECT (lcCurAlias)
ENDIF
*-* Restore default settings
IF lcSetPoint != "."
SET POINT TO (lcSetPoint)
SET SEPARATOR TO (lcSeparator)
ENDIF
RETURN llSuccess
ENDPROC
PROCEDURE saveworkbook && Saves the selected workbook as an XLSX file
LPARAMETERS tnWB
LOCAL lcTempPath, lnSheet, lcDeleted, lcSetPoint, lcSeparator, lcSetDeleted, llReturn, lcAlias
LOCAL lcSafety, lnTotStages
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
llReturn = True
lcAlias = ALIAS()
lcSafety = SET("SAFETY")
lcSetDeleted = SET("DELETED")
lcSetPoint = SET("POINT")
lcSeparator = SET("SEPARATOR")
SET SAFETY OFF
SET POINT TO "."
SET SEPARATOR TO ","
SET DELETED ON
*-* Write the XLSX Workbook to XML structures
lcTempPath = this.CreateWorkingDirectories()
IF ISNULL(lcTempPath)
llReturn = False
ELSE
SELECT xl_sheets
COUNT FOR workbook = tnWB .AND. !shdeleted TO lnTotStages
lnTotStages = lnTotStages + 5
RAISEEVENT(this, "OnShowStatusMessage", 2, 0, lnTotStages)
IF this.WriteStringsXML(tnWB, lcTempPath) ;
.AND. this.WriteSupportXMLs(tnWB, lcTempPath) ;
.AND. this.WriteStylesXML(tnWB, lcTempPath) ;
.AND. this.WriteWorkbookXML(tnWB, lcTempPath) ;
.AND. this.WriteRelationshipsXML(tnWB, lcTempPath)
lnSheet = 0
SELECT xl_sheets
SET ORDER TO TAG sheet
SCAN FOR workbook = tnWB .AND. !shdeleted
lnSheet = lnSheet + 1
RAISEEVENT(this, "OnShowStatusMessage", 2, lnSheet+5)
IF !this.WriteSheetXMLs(tnWB, xl_sheets.sheet, lcTempPath)
llReturn = False
EXIT
ENDIF
ENDSCAN
SELECT xl_sheets
SET ORDER TO
IF llReturn .AND. SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
llReturn = this.CreateExcelFile(lcTempPath, xl_workbooks.filepath, xl_workbooks.wbname)
ENDIF
ELSE
llReturn = False
ENDIF
this.RemoveWorkingDirectories(lcTempPath)
RAISEEVENT(this, "OnShowStatusMessage", 2, -1)
ENDIF
SET SAFETY &lcSafety
SET DELETED &lcSetDeleted
SET POINT TO (lcSetPoint)
SET SEPARATOR TO (lcSeparator)
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE saveworkbookas && Saves the selected workbook with the new name
LPARAMETERS tnWB, tcWBName
LOCAL lcName, lcPath
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook") .AND. !EMPTY(tcWBName)
lcName = JUSTSTEM(tcWBName)
lcPath = JUSTPATH(tcWBName)
IF EMPTY(lcPath)
lcPath = SYS(5) + SYS(2003)
ENDIF
REPLACE xl_workbooks.wbname WITH lcName, ;
xl_workbooks.filepath WITH lcPath IN xl_workbooks
this.SaveWorkbook(tnWB)
ENDIF
ENDPROC
PROCEDURE setcellalignment && Sets the cell horizontal and vertical alignments
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tcHorizAlign, tcVertAlign
LOCAL llReturn, lnCellXfsId, lcAlias
IF PCOUNT() < 4 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
DO CASE
CASE VARTYPE(tcHorizAlign) = 'C' .AND. VARTYPE(tcVertAlign) = 'C'
IF INLIST(tcHorizAlign, CELL_HORIZ_ALIGN_LEFT, CELL_HORIZ_ALIGN_RIGHT, CELL_HORIZ_ALIGN_CENTER) .AND. ;
INLIST(tcVertAlign, CELL_VERT_ALIGN_TOP, CELL_VERT_ALIGN_BOTTOM, CELL_VERT_ALIGN_CENTER)
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontId, xl_cellxfs.fillId, xl_cellxfs.borderId, tcHorizAlign, tcVertAlign, xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.halign WITH tcHorizAlign, ;
xl_cellxfs.valign WITH tcVertAlign IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, tcHorizAlign, tcVertAlign, 0, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, tcHorizAlign, tcVertAlign, 0, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
CASE VARTYPE(tcHorizAlign) = 'C' .AND. VARTYPE(tcVertAlign) != 'C'
IF INLIST(tcHorizAlign, CELL_HORIZ_ALIGN_LEFT, CELL_HORIZ_ALIGN_RIGHT, CELL_HORIZ_ALIGN_CENTER)
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontId, xl_cellxfs.fillId, xl_cellxfs.borderId, tcHorizAlign, "", xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.halign WITH tcHorizAlign, ;
xl_cellxfs.valign WITH "" IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, tcHorizAlign, "", 0, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, tcHorizAlign, "", 0, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
CASE VARTYPE(tcHorizAlign) != 'C' .AND. VARTYPE(tcVertAlign) = 'C'
IF INLIST(tcVertAlign, CELL_VERT_ALIGN_TOP, CELL_VERT_ALIGN_BOTTOM, CELL_VERT_ALIGN_CENTER)
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontId, xl_cellxfs.fillId, xl_cellxfs.borderId, "", tcVertAlign, xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.halign WITH "", ;
xl_cellxfs.valign WITH tcVertAlign IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", tcVertAlign, 0, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", tcVertAlign, 0, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
OTHERWISE
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.halign WITH "", ;
xl_cells.valign WITH "" IN xl_cells
ENDIF
llReturn = True
ENDCASE
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellalignmentrange && Sets the cell alignment for a range of cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tcHorizAlign, tcVertAlign
LOCAL lnRow, lnCol, llReturn
IF PCOUNT() < 7 .OR. this.IsCellReferenceInvalid(tnBegRow, tnBegCol) .OR. this.IsCellReferenceInvalid(tnEndRow, tnEndCol)
RETURN False
ENDIF
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN False
ENDIF
llReturn = True
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF !this.SetCellAlignment(tnWB, tnSheet, lnRow, lnCol, tcHorizAlign, tcVertAlign)
llReturn = False
EXIT
ENDIF
ENDFOR
ENDFOR
RETURN llReturn
ENDPROC
PROCEDURE setcellborder
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnBorders, tcStyle, tnColor
LOCAL lcLStyle, lnLColor, lcRStyle, lcTStyle, lnTColor, lcBStyle, lnBColor, lcDStyle, lnDColor, lnDiagDn, lnDiagUp
LOCAL lnRColor, llReturn, lcAlias
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
IF VARTYPE(tnBorders) != 'N' .OR. EMPTY(tnBorders) .OR. !BETWEEN(tnBorders, 0, 63)
tnBorders = 0
ENDIF
IF !this.IsValidBorderStyle(tcStyle)
tcStyle = BORDER_STYLE_NONE
ENDIF
IF VARTYPE(tnColor) != 'N' .OR. !BETWEEN(tnColor, 0, RGB(255,255,255)) .OR. EMPTY(tnColor)
tnColor = RGB(0, 0, 0)
ENDIF
STORE 0 TO lnDiagDn, lnDiagUp
STORE RGB(0,0,0) TO lnLColor, lnRColor, lnTColor, lnBColor, lnDColor
STORE BORDER_STYLE_NONE TO lcLStyle, lcRStyle, lcTStyle, lcBStyle, lcDStyle
IF BITTEST(tnBorders, 0)
lcLStyle = tcStyle
lnLColor = tnColor
ENDIF
IF BITTEST(tnBorders, 1)
lcRStyle = tcStyle
lnRColor = tnColor
ENDIF
IF BITTEST(tnBorders, 2)
lcTStyle = tcStyle
lnTColor = tnColor
ENDIF
IF BITTEST(tnBorders, 3)
lcBStyle = tcStyle
lnBColor = tnColor
ENDIF
IF BITTEST(tnBorders, 4)
lcDStyle = tcStyle
lnDColor = tnColor
lnDiagDn = 1
ENDIF
IF BITTEST(tnBorders, 5)
lcDStyle = tcStyle
lnDColor = tnColor
lnDiagUp = 1
ENDIF
this.SetCellBorderEx(tnWB, tnSheet, tnCellRow, tnCellCol, lcLStyle, lnLColor, lcRStyle, lnRColor, ;
lcTStyle, lnTColor, lcBStyle, lnBColor, lcDStyle, lnDColor, lnDiagDn, lnDiagUp)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellborderex
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tcLStyle, tnLColor, tcRStyle, tnRColor, tcTStyle, tnTColor, tcBStyle, tnBColor, tcDStyle, tnDColor, tnDiagDn, tnDiagUp
LOCAL lnCellXfsId, lnBorderId
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF !this.IsValidBorderStyle(tcLStyle)
tcLStyle = BORDER_STYLE_NONE
ENDIF
IF VARTYPE(tnLColor) != 'N' .OR. EMPTY(tnLColor) .OR. !BETWEEN(tnLColor, 0, RGB(255,255,255))
tnLColor = RGB(0, 0, 0)
ENDIF
IF !this.IsValidBorderStyle(tcRStyle)
tcRStyle = BORDER_STYLE_NONE
ENDIF
IF VARTYPE(tnRColor) != 'N' .OR. EMPTY(tnRColor) .OR. !BETWEEN(tnRColor, 0, RGB(255,255,255))
tnRColor = RGB(0, 0, 0)
ENDIF
IF !this.IsValidBorderStyle(tcTStyle)
tcTStyle = BORDER_STYLE_NONE
ENDIF
IF VARTYPE(tnTColor) != 'N' .OR. EMPTY(tnTColor) .OR. !BETWEEN(tnTColor, 0, RGB(255,255,255))
tnTColor = RGB(0, 0, 0)
ENDIF
IF !this.IsValidBorderStyle(tcBStyle)
tcBStyle = BORDER_STYLE_NONE
ENDIF
IF VARTYPE(tnBColor) != 'N' .OR. EMPTY(tnBColor) .OR. !BETWEEN(tnBColor, 0, RGB(255,255,255))
tnBColor = RGB(0, 0, 0)
ENDIF
IF !this.IsValidBorderStyle(tcDStyle)
tcDStyle = BORDER_STYLE_NONE
ENDIF
IF VARTYPE(tnDColor) != 'N' .OR. EMPTY(tnDColor) .OR. !BETWEEN(tnDColor, 0, RGB(255,255,255))
tnDColor = RGB(0, 0, 0)
ENDIF
IF VARTYPE(tnDiagDn) != 'N' .OR. !BETWEEN(tnDiagDn, 0, 3)
tnDiagDn = 0
ENDIF
IF VARTYPE(tnDiagUp) != 'N' .OR. !BETWEEN(tnDiagUp, 0, 3)
tnDiagUp = 0
ENDIF
*-* Get the border record Id
IF this.GetBordersRecord(tnWB, tcLStyle, tnLColor, tcRStyle, tnRColor, tcTStyle, tnTColor, tcBStyle, tnBColor, tcDStyle, tnDColor, tnDiagDn, tnDiagUp)
lnBorderId = xl_borders.id
ELSE
lnBorderId = this.GetNextId(tnWB, 'xl_borders')
INSERT INTO xl_borders (workbook, id, lstyle, lcolor, rstyle, rcolor, tstyle, tcolor, bstyle, bcolor, dstyle, dcolor, diagdn, diagup) ;
VALUES (tnWB, lnBorderId, tcLStyle, tnLColor, tcRStyle, tnRColor, tcTStyle, tnTColor, tcBStyle, tnBColor, tcDStyle, tnDColor, tnDiagDn, tnDiagUp)
ENDIF
*-* Set the XfsId to the cell record
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontId, xl_cellxfs.fillId, lnBorderId, xl_cellxfs.halign, xl_cellxfs.valign, xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.borderId WITH lnBorderId IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, lnBorderId, "", "", 0, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, lnBorderId, "", "", 0, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellborderrange && Sets the cell border for a range of cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tnBorder, tcStyle, tnColor
LOCAL llReturn, lnRow, lnCol
IF PCOUNT() < 7 .OR. this.IsCellReferenceInvalid(tnBegRow, tnBegCol) .OR. this.IsCellReferenceInvalid(tnEndRow, tnEndCol)
RETURN False
ENDIF
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN False
ENDIF
llReturn = True
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF !this.SetCellBorder(tnWB, tnSheet, lnRow, lnCol, tnBorder, tcStyle, tnColor)
llReturn = False
EXIT
ENDIF
ENDFOR
ENDFOR
RETURN llReturn
ENDPROC
PROCEDURE setcellfill && Sets the fill color for the cell
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnFColor, tnBColor, tcPatternType
LOCAL llReturn, lnFillId, lnCellXfsId, lnFIndex, lnBIndex, lcAlias
DO CASE
CASE PCOUNT() < 5
RETURN False
CASE PCOUNT() = 5
tnBColor = RGB(255,255,255)
tcPatternType = FILL_STYLE_SOLID
CASE PCOUNT() = 6
tcPatternType = FILL_STYLE_SOLID
ENDCASE
IF this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
lcAlias = ALIAS()
IF PCOUNT() = 5 .OR. PCOUNT() = 6 .OR. VARTYPE(tcPatternType) != "C" .OR. EMPTY(tcPatternType)
tcPatternType = FILL_STYLE_SOLID
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF VARTYPE(tnBColor) != 'N'
tnBColor = RGB(255,255,255)
ENDIF
IF VARTYPE(tnFColor) = 'N' .AND. BETWEEN(tnFColor, 0, RGB(255, 255, 255))
tnFColor = FLOOR(tnFColor)
lnFIndex = 0
ELSE
tnFColor = 0
lnFIndex = 64
ENDIF
IF VARTYPE(tnBColor) = 'N' .AND. BETWEEN(tnBColor, 0, RGB(255, 255, 255))
tnBColor = FLOOR(tnBColor)
lnBIndex = 0
ELSE
tnBColor = RGB(0, 0, 0)
lnBIndex = 64
ENDIF
*-* Get the fill record id
IF SEEK(BINTOC(tnWB)+BINTOC(tnFColor)+BINTOC(tnBColor)+tcPatternType, "xl_fills", "fillcolor")
lnFillId = xl_fills.id
REPLACE xl_fills.theme WITH 0, ;
xl_fills.tint WITH 0, ;
xl_fills.fgindexed WITH lnFIndex, ;
xl_fills.bgindexed WITH lnBIndex IN xl_fills
ELSE
lnFillId = this.GetNextId(tnWB, 'xl_fills')
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed) ;
VALUES (tnWB, lnFillId, tnFColor, tnBColor, tcPatternType, 0, 0, lnFIndex, lnBIndex)
ENDIF
*-* Set the XfsId to the cell record
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontId, lnFillId, xl_cellxfs.borderId, xl_cellxfs.halign, xl_cellxfs.valign, xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.fillId WITH lnFillId IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, lnFillId, 0, "", "", 0, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, lnFillId, 0, "", "", 0, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellfillrange && Sets the fill for a range of cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tnFColor, tnBColor, tcPatternType
LOCAL lnRow, lnCol, llReturn
DO CASE
CASE PCOUNT() < 7
RETURN False
CASE PCOUNT() = 7
tnBColor = RGB(255,255,255)
tcPatternType = FILL_STYLE_SOLID
CASE PCOUNT() = 8
tcPatternType = FILL_STYLE_SOLID
ENDCASE
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol .OR. this.IsCellReferenceInvalid(tnBegRow, tnBegCol) .OR. this.IsCellReferenceInvalid(tnEndRow, tnEndCol)
RETURN False
ENDIF
IF VARTYPE(tnBColor) != 'N'
tnBColor = RGB(255,255,255)
ENDIF
llReturn = True
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF !this.SetCellFill(tnWB, tnSheet, lnRow, lnCol, tnFColor, tnBColor, tcPatternType)
llReturn = False
EXIT
ENDIF
ENDFOR
ENDFOR
RETURN llReturn
ENDPROC
PROCEDURE setcellfont && Sets the selected cell font format
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos
LOCAL llReturn, lcAlias
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
IF VARTYPE(tcFName) != 'C' .OR. EMPTY(tcFName)
tcFName = 'Calibri'
ENDIF
tcFName = PROPER(ALLTRIM(tcFName))
IF VARTYPE(tnFSize) != 'N' .OR. EMPTY(tnFSize) .OR. tnFSize < 0.5
tnFSize = 11
ELSE
tnFSize = INT(tnFSize)
ENDIF
IF VARTYPE(tlBold) != 'L'
tlBold = False
ENDIF
IF VARTYPE(tlItalic) != 'L'
tlItalic = False
ENDIF
IF VARTYPE(tnFColor) = 'N' .AND. BETWEEN(tnFColor, 0, RGB(255, 255, 255))
tnFColor = FLOOR(tnFColor)
ELSE
tnFColor = RGB(0, 0, 0)
ENDIF
IF VARTYPE(tlStrikThr) != 'L'
tlStrikThr = False
ENDIF
IF VARTYPE(tcULine) != 'C' .OR. !INLIST(tcULine, UNDERLINE_SINGLE, UNDERLINE_DOUBLE, UNDERLINE_SINGLEACCOUNTING, UNDERLINE_DOUBLEACCOUNTING, UNDERLINE_NONE)
tcULine = UNDERLINE_NONE
ENDIF
IF VARTYPE(tcVPos) != 'C' .OR. !INLIST(tcVPos, FONT_VERTICAL_BASELINE, FONT_VERTICAL_SUBSCRIPT, FONT_VERTICAL_SUPERSCRIPT)
tcVPos = FONT_VERTICAL_BASELINE
ENDIF
*-* Get the font record id
IF SEEK(BINTOC(tnWB)+PADR(tcFName, 100) + STR(tnFSize, 5, 1) + TRANSFORM(tlBold) + TRANSFORM(tlItalic) + PADL(tnFColor, 15) + PADR(tcULine, 16) + ;
TRANSFORM(tlStrikThr) + PADR(tcVPos, 11), "xl_fonts", "cellformat")
lnFontId = xl_fonts.id
REPLACE xl_fonts.theme WITH 0, ;
xl_fonts.tint WITH 0, ;
xl_fonts.indexed WITH 0 IN xl_fonts
ELSE
lnFontId = this.GetNextId(tnWB, 'xl_fonts')
INSERT INTO xl_fonts (workbook, id, fname, fsize, fbold, fitalic, fcolor, uline, strkthr, fvpos) ;
VALUES (tnWB, lnFontId, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos)
ENDIF
*-* Set the XfsId to the cell record
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, lnFontId, xl_cellxfs.fillid, xl_cellxfs.borderId, xl_cellxfs.halign, xl_cellxfs.valign, xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.fontid WITH lnFontId IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, lnFontId, 0, 0, "", "", 0, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, lnFontId, 0, 0, "", "", 0, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellfontrange && Sets the cell font format for a range of cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos
LOCAL lnRow, lnCol, llReturn
IF PCOUNT() < 7 .OR. this.IsCellReferenceInvalid(tnBegRow, tnBegCol) .OR. this.IsCellReferenceInvalid(tnEndRow, tnEndCol)
RETURN False
ENDIF
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN False
ENDIF
llReturn = True
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF !this.SetCellFont(tnWB, tnSheet, lnRow, lnCol, tcFName, tnFSize, tlBold, tlItalic, tnFColor, tcULine, tlStrikThr, tcVPos)
llReturn = False
EXIT
ENDIF
ENDFOR
ENDFOR
RETURN llReturn
ENDPROC
PROCEDURE setcellformula && Sets the cell formula expression
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tcCellFormula
LOCAL llReturn, lcAlias
IF PCOUNT() < 5 .OR. VARTYPE(tcCellFormula) != "C" .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.cellvalue WITH "", ;
xl_cells.cellformula WITH tcCellFormula, ;
xl_cells.stringid WITH 0, ;
xl_cells.datatype WITH DATA_TYPE_FORMULA, ;
xl_cells.celldeleted WITH False IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, cellformula, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, tcCellFormula, DATA_TYPE_FORMULA, 0, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellindent && Sets the cell indentation value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnIndent
LOCAL lnCellXfsId, lcAlias
IF PCOUNT() != 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF VARTYPE(tnIndent) != 'N'
RETURN False
ENDIF
lcAlias = ALIAS()
tnIndent = FLOOR(tnIndent)
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontid, xl_cellxfs.fillid, xl_cellxfs.borderId, xl_cellxfs.halign, xl_cellxfs.valign, tnIndent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.indent WITH tnIndent IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", "", tnIndent, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", "", tnIndent, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN True
ENDPROC
PROCEDURE setcellinlineformattext && Saves the in-line format definition to a cell value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, toInLine
LOCAL lnNdx, lcRText, llFBold, llFItalic, lnFColor, lcFName, lnFSize, lcULine, llStrkThr, lcFVPos, lcAlias
IF this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF tnWB = toInLine.Workbook
lcAlias = ALIAS()
IF ISNULL(toInLine.StringId)
toInLine.StringId = this.AddStringValue(toInLine.Workbook, toInLine.StringValue, True)
ENDIF
IF this.GetCellRecord(toInLine.Workbook, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.cellvalue WITH "StringValue", ;
xl_cells.cellxfs WITH 0, ;
xl_cells.cellformula WITH "", ;
xl_cells.stringid WITH toInLine.StringId, ;
xl_cells.datatype WITH DATA_TYPE_CHAR, ;
xl_cells.celldeleted WITH False IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, cellvalue, stringid, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (toInLine.Workbook, tnSheet, tnCellRow, tnCellCol, "StringValue", toInLine.StringId, DATA_TYPE_CHAR, 0, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
FOR lnNdx=1 TO toInLine.Count
lcRText = SUBSTR(toInLine.StringValue, toInLine.Characters[lnNdx].BegPos, toInLine.Characters[lnNdx].Length)
llFBold = toInLine.Characters[lnNdx].FontBold
llFItalic = toInLine.Characters[lnNdx].FontItalic
lnFColor = toInLine.Characters[lnNdx].FontColor
lcFName = toInLine.Characters[lnNdx].FontName
lnFSize = toInLine.Characters[lnNdx].FontSize
lcULine = toInLine.Characters[lnNdx].Underline
llStrkThr = toInLine.Characters[lnNdx].StrikeThru
lcFVPos = ICASE(toInLine.Characters[lnNdx].SubScript, FONT_VERTICAL_SUBSCRIPT, toInLine.Characters[lnNdx].SuperScript, FONT_VERTICAL_SUPERSCRIPT, FONT_VERTICAL_BASELINE)
INSERT INTO xl_strformat (workbook, id, index, stringxml, stringval, fbold, fitalic, fcolor, fname, fsize, uline, strkthr, fvpos, theme, tint, indexed) ;
VALUES (toInLine.Workbook, toInLine.StringId, lnNdx, this.GetXMLString(lcRText), lcRText, llFBold, llFItalic, lnFColor, lcFName, lnFSize, lcULine, ;
llStrkThr, lcFVPos, 0, 0, 0)
ENDFOR
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE setcellnumberdecimals && Sets the number of decimals to display
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnNumDecimals
LOCAL lcAlias
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF VARTYPE(tnNumDecimals) != 'N' .OR. tnNumDecimals < 0
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.numdec WITH tnNumDecimals IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, nbrfmtid, numdec, celldeleted) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, 0, tnNumDecimals, False)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN True
ENDPROC
PROCEDURE setcellnumberformat && Sets the cell number format
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnNumFormat
LOCAL llReturn, lnNumFmtId, lcAlias, loException
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF VARTYPE(tnNumFormat) != 'N'
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
DO CASE
CASE tnNumFormat < START_NUMERIC_FORMAT_ID
lnNumFmtId = tnNumFormat
CASE tnNumFormat >= START_NUMERIC_FORMAT_ID
IF SEEK(BINTOC(tnWB)+BINTOC(tnNumFormat), "xl_numfmts", "id")
lnNumFmtId = xl_numfmts.id
ELSE
IF !this.AddClassDefinedNumericFormats(tnWB, tnNumFormat)
RETURN False
ENDIF
lnNumFmtId = tnNumFormat
ENDIF
OTHERWISE
RETURN False
ENDCASE
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, lnNumFmtId, xl_cellxfs.fontid, xl_cellxfs.fillid, xl_cellxfs.borderId, xl_cellxfs.halign, xl_cellxfs.valign, xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
TRY
REPLACE xl_cellxfs.numFmtId WITH lnNumFmtId IN xl_cellxfs
CATCH TO loException
SET STEP ON
ENDTRY
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, lnNumFmtId, 0, 0, 0, "", "", 0, 0, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, lnNumFmtId, 0, 0, 0, "", "", 0, 0, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellnumberformatrange && Sets the number format for a range of cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tnNumFormat
LOCAL lnRow, lnCol, llReturn
IF PCOUNT() < 7 .OR. this.IsCellReferenceInvalid(tnBegRow, tnBegCol) .OR. this.IsCellReferenceInvalid(tnEndRow, tnEndCol)
RETURN False
ENDIF
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN False
ENDIF
llReturn = True
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF !this.SetCellNumberFormat(tnWB, tnSheet, lnRow, lnCol, tnNumFormat)
llReturn = False
EXIT
ENDIF
ENDFOR
ENDFOR
RETURN llReturn
ENDPROC
PROCEDURE setcellstyle && Sets the cell style
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnCellXfsId
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.cellxfs WITH tnCellXfsId IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, tnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, lnRow, lnCol)
ENDIF
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE setcellstylerange && Sets the cell style for a range of cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tnCellXfsId
LOCAL lnRow, lnCol
IF PCOUNT() < 7 .OR. tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF this.GetCellRecord(tnWB, tnSheet, lnRow, lnCol)
REPLACE xl_cells.cellxfs WITH tnCellXfsId IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, lnRow, lnCol, DATA_TYPE_NONE, tnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, lnRow, lnCol)
ENDIF
ENDFOR
ENDFOR
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE setcelltextrotation && Sets the cell text rotation value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnRotation
LOCAL lnCellXfsId, lcAlias
IF PCOUNT() != 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF VARTYPE(tnRotation) != 'N'
RETURN False
ENDIF
IF !BETWEEN(tnRotation, -90, 90)
RETURN False
ENDIF
lcAlias = ALIAS()
tnRotation = FLOOR(tnRotation)
IF tnRotation < 0
tnRotation = 90 - tnRotation
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontid, xl_cellxfs.fillid, xl_cellxfs.borderId, xl_cellxfs.halign, xl_cellxfs.valign, xl_cellxfs.indent, xl_cellxfs.wraptext, tnRotation)
ELSE
REPLACE xl_cellxfs.rotation WITH tnRotation IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", "", 0, 0, tnRotation)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", "", 0, 0, tnRotation)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN True
ENDPROC
PROCEDURE setcellvalidation && Adds a cell validation
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnType, tnStyle, tnOperator, tlAllowBlank, tlShowInputMsg, tlShowErrMsg, tcErrMsg, tcErrTitle, tcPrompt, tcFormula1, tcFormula2
LOCAL lcAlias, lnIndex, llFormula
lcAlias = ALIAS()
IF PCOUNT() < 14 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF !BETWEEN(tnType, 0, CUSTOM_VALID_TYPE)
RETURN False
ENDIF
IF VARTYPE(tcFormula1) != "C"
tcFormula1 = TRANSFORM(tcFormula1)
ENDIF
IF EMPTY(tcFormula1) .OR. LEN(tcFormula1) > 254
RETURN False
ENDIF
IF LEFT(tcFormula1, 1) = "="
llFormula = True
tcFormula1 = ALLTRIM(SUBSTR(tcFormula1, 2))
ELSE
llFormula = False
ENDIF
IF PCOUNT() < 15
tcFormula2 = ""
ENDIF
IF VARTYPE(tcFormula2) != "C"
tcFormula2 = TRANSFORM(tcFormula2)
ENDIF
IF LEN(tcFormula2) > 254
RETURN False
ENDIF
IF LEFT(tcFormula2, 1) = "="
tcFormula2 = ALLTRIM(SUBSTR(tcFormula2, 2))
ENDIF
IF VARTYPE(tnStyle) = "N"
IF !BETWEEN(tnStyle, 0, INFO_VALID_STYLE)
RETURN False
ENDIF
ELSE
tnStyle = 0
ENDIF
IF VARTYPE(tnOperator) = "N"
IF !BETWEEN(tnOperator, 0, GREATOREQUAL_VALID_OPER)
RETURN False
ENDIF
ELSE
tnOperator = 0
ENDIF
IF VARTYPE(tcErrMsg) != "C"
tcErrMsg = ""
ENDIF
IF VARTYPE(tcErrTitle) != "C"
tcErrTitle = ""
ENDIF
IF VARTYPE(tcPrompt) != "C"
tcPrompt = ""
ENDIF
IF VARTYPE(tlAllowBlank) != "L"
tlAllowBlank = True
ENDIF
IF VARTYPE(tlShowInputMsg) != "L"
tlShowInputMsg = True
ENDIF
IF VARTYPE(tlShowErrMsg) != "L"
tlShowErrMsg = True
ENDIF
*-* Check if the cell is part of a merged range of cells; if so set the cell to the upper left cell of the merged range
IF RECCOUNT('xl_mergecells') > 0
SELECT xl_mergecells
LOCATE FOR workbook = tnWB .AND. sheet = tnSheet .AND. BETWEEN(tnCellRow, begrow, endrow) .AND. BETWEEN(tnCellCol, begcol, endcol) .AND. !DELETED()
IF FOUND()
tnCellRow = xl_mergecells.begrow
tnCellCol = xl_mergecells.begcol
ENDIF
ENDIF
SELECT xl_validation
LOCATE FOR BINTOC(workbook)+BINTOC(sheet) = BINTOC(tnWB)+BINTOC(tnSheet) ;
.AND. UPPER(formula1) = UPPER(PADR(tcFormula1, 240)) ;
.AND. UPPER(formula2) = UPPER(PADR(tcFormula2, 240)) .AND. !DELETED()
IF FOUND()
lnIndex = 0
DO WHILE FOUND()
IF xl_validation.vtype = tnType ;
.AND. xl_validation.vstyle = tnStyle ;
.AND. xl_validation.voperator = tnOperator ;
.AND. xl_validation.errmsg = tcErrMsg ;
.AND. xl_validation.errtitle = tcErrTitle ;
.AND. xl_validation.allowblank = tlAllowBlank ;
.AND. xl_validation.showinpmsg = tlShowInputMsg ;
.AND. xl_validation.showerrmsg = tlShowErrMsg ;
.AND. xl_validation.vprompt = tcPrompt
lnIndex = xl_validation.validndx
EXIT
ENDIF
CONTINUE
ENDDO
IF lnIndex = 0
INSERT INTO xl_validation (workbook, sheet, vtype, vstyle, voperator, errmsg, errtitle, vprompt, allowblank, showinpmsg, showerrmsg, formula, formula1, formula2) ;
VALUES (tnWB, tnSheet, tnType, tnStyle, tnOperator, tcErrMsg, tcErrTitle, tcPrompt, tlAllowBlank, tlShowInputMsg, tlShowErrMsg, llFormula, tcFormula1, tcFormula2)
lnIndex = xl_validation.validndx
ENDIF
ELSE
INSERT INTO xl_validation (workbook, sheet, vtype, vstyle, voperator, errmsg, errtitle, vprompt, allowblank, showinpmsg, showerrmsg, formula, formula1, formula2) ;
VALUES (tnWB, tnSheet, tnType, tnStyle, tnOperator, tcErrMsg, tcErrTitle, tcPrompt, tlAllowBlank, tlShowInputMsg, tlShowErrMsg, llFormula, tcFormula1, tcFormula2)
lnIndex = xl_validation.validndx
ENDIF
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.validndx WITH lnIndex IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, 0, False, -1, lnIndex)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN True
ENDPROC
PROCEDURE setcellvalue && Sets the cell value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, txCellValue
LOCAL lcCellValue, lcDataType, lnStringNdx, lnSetDecimals, lnWholePart, lnFractPart, lcAlias, lnNumFmtId, lcHorzAlign
LOCAL lcSetDate, lcSetPoint, lcSeparator, lcCurrency
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
lcAlias = ALIAS()
*-* Check if the cell is part of a merged range of cells; if so set the cell to the upper left cell of the merged range
IF RECCOUNT('xl_mergecells') > 0
SELECT xl_mergecells
LOCATE FOR workbook = tnWB .AND. sheet = tnSheet .AND. tnCellRow >= begrow .AND. tnCellRow <= endrow .AND. tnCellCol >= begcol .AND. tnCellCol <= endcol .AND. !DELETED()
IF FOUND()
tnCellRow = xl_mergecells.begrow
tnCellCol = xl_mergecells.begcol
ENDIF
ENDIF
*-* Assign the data type based on type of value and add to cell
lnStringNdx = 0
lcHorzAlign = ""
lnNumFmtId = 0
lcSetPoint = SET("POINT")
lcSeparator = SET("SEPARATOR")
IF lcSetPoint != "." && Change recommended by Doug Hennig; 2017-06-12
SET POINT TO "."
SET SEPARATOR TO ","
ENDIF
DO CASE
CASE VARTYPE(txCellValue) = DATA_TYPE_LOGICAL
lcDataType = DATA_TYPE_LOGICAL
lcCellValue = "StringValue"
txCellValue = IIF(txCellValue, GETWORDNUM(this.TrueFalseValue, 1, "|"), GETWORDNUM(this.TrueFalseValue, 2, "|"))
lnStringNdx = this.AddStringValue(tnWB, txCellValue, False)
CASE VARTYPE(txCellValue) = DATA_TYPE_CHAR
txCellValue = ALLTRIM(txCellValue)
IF LEN(txCellValue) > LIMITS_MAX_CELL_CHARS
RETURN False
ENDIF
lcDataType = DATA_TYPE_CHAR
lcCellValue = "StringValue"
lnStringNdx = this.AddStringValue(tnWB, txCellValue, False)
DELETE FOR workbook = tnWB .AND. id = lnStringNdx IN xl_strformat
CASE VARTYPE(txCellValue) = DATA_TYPE_DATE
IF txCellValue >= DATE(1900, 1, 1)
lcDataType = DATA_TYPE_DATE
lcCellValue = TRANSFORM(INT(txCellValue - DATE(1900, 1, 1) + 2))
ELSE
lcDataType = DATA_TYPE_CHAR
lcCellValue = "StringValue"
lcSetDate = SET("DATE")
SET DATE TO AMERICAN
lnStringNdx = this.AddStringValue(tnWB, TRANSFORM(txCellValue), False)
SET DATE TO (lcSetDate)
ENDIF
lcHorzAlign = CELL_HORIZ_ALIGN_LEFT
lnNumFmtId = CELL_FORMAT_DATE_MMDDYY
CASE VARTYPE(txCellValue) = DATA_TYPE_DATETIME
IF TTOD(txCellValue) >= DATE(1900, 1, 1)
lnSetDecimals = SET("DECIMALS")
SET DECIMALS TO 12
lcDataType = DATA_TYPE_DATETIME
lnWholePart = INT(TTOD(txCellValue) - DATE(1900, 1, 1) + 2)
lnFractPart = ((HOUR(txCellValue) * 60 + MINUTE(txCellValue)) * 60 + SEC(txCellValue)) / (24 * 60 * 60)
lcCellValue = TRANSFORM(lnWholePart + lnFractPart)
SET DECIMALS TO (lnSetDecimals)
ELSE
lcDataType = DATA_TYPE_CHAR
lcCellValue = "StringValue"
lcSetDate = SET("DATE")
SET DATE TO AMERICAN
lnStringNdx = this.AddStringValue(tnWB, TRANSFORM(txCellValue), False)
SET DATE TO (lcSetDate)
ENDIF
lcHorzAlign = CELL_HORIZ_ALIGN_LEFT
lnNumFmtId = CELL_FORMAT_DATETIME_MMMDDYYYY_TTAM
CASE VARTYPE(txCellValue) = DATA_TYPE_FLOAT
lcCellValue = TRANSFORM(txCellValue)
IF ATC(".", lcCellValue) > 0
lcDataType = DATA_TYPE_FLOAT
ELSE
lcDataType = DATA_TYPE_INT
ENDIF
CASE VARTYPE(txCellValue) = DATA_TYPE_CURRENCY
IF this.SaveCurrencyAsNumeric
lcDataType = DATA_TYPE_FLOAT && Change requested by Tony Federer
lcCellValue = TRANSFORM(MTON(txCellValue))
ELSE
lcCurrency = SET("Currency", 1)
lcCellValue = CHRTRAN(TRANSFORM(txCellValue), lcCurrency+",", "")
lcDataType = DATA_TYPE_CURRENCY
lcHorzAlign = CELL_HORIZ_ALIGN_RIGHT
DO CASE
CASE lcCurrency = "<22>"
lnNumFmtId = CELL_FORMAT_ACC_CURR_POUNDS
CASE lcCurrency = "<22>"
lnNumFmtId = CELL_FORMAT_ACC_CURR_EURO
OTHERWISE
lnNumFmtId = CELL_FORMAT_CURRENCY_PAREN
ENDCASE
ENDIF
CASE VARTYPE(txCellValue) = DATA_TYPE_GENERAL
lcDataType = DATA_TYPE_GENERAL
lcCellValue = "" && Change recommendation by Doug Hennig
OTHERWISE
lcDataType = DATA_TYPE_GENERAL
lcCellValue = TRANSFORM(txCellValue)
ENDCASE
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, lnNumFmtId, xl_cellxfs.fontid, xl_cellxfs.fillid, xl_cellxfs.borderId, xl_cellxfs.halign, xl_cellxfs.valign, xl_cellxfs.indent, xl_cellxfs.wraptext, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.numFmtId WITH lnNumFmtId IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, lnNumFmtId, 0, 0, 0, "", "", 0, 0, 0)
ENDIF
REPLACE xl_cells.cellvalue WITH lcCellValue, ;
xl_cells.cellxfs WITH lnCellXfsId, ;
xl_cells.cellformula WITH "", ;
xl_cells.stringid WITH lnStringNdx, ;
xl_cells.datatype WITH lcDataType, ;
xl_cells.celldeleted WITH False IN xl_cells
ELSE
IF lnNumFmtId > 0
lnCellXfsId = this.GetCellXfsId(tnWB, lnNumFmtId, 0, 0, 0, "", "", 0, 0, 0)
ELSE
lnCellXfsId = 0
ENDIF
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, cellvalue, stringid, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, lcCellValue, lnStringNdx, lcDataType, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
IF lcSetPoint != "." && Change recommended by Doug Hennig; 2017-06-12
SET POINT TO (lcSetPoint)
SET SEPARATOR TO (lcSeparator)
ENDIF
RETURN True
ENDPROC
PROCEDURE setcellwordwrap && Sets the cell word-wrapping value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tlWordWrap
LOCAL llReturn, lnWrapText, lnCellXfsId, lcAlias
IF PCOUNT() < 5 .OR. VARTYPE(tlWordWrap) != "L" .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
lnWrapText = IIF(tlWordWrap, 1, 0)
*-* Set the XfsId to the cell record
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
IF xl_cells.cellxfs > 0 .AND. this.GetCellXfsRecord(tnWB, xl_cells.cellxfs)
lnCellXfsId = xl_cellxfs.id
SELECT workbook FROM xl_cells WHERE workbook = tnWB AND cellxfs = lnCellXfsId INTO CURSOR xl_temp
IF _TALLY > 1
lnCellXfsId = this.GetCellXfsId(tnWB, xl_cellxfs.numFmtId, xl_cellxfs.fontId, xl_cellxfs.fillid, xl_cellxfs.borderId, xl_cellxfs.halign, xl_cellxfs.valign, xl_cellxfs.indent, lnWrapText, xl_cellxfs.rotation)
ELSE
REPLACE xl_cellxfs.wraptext WITH lnWrapText IN xl_cellxfs
ENDIF
USE IN SELECT('xl_temp')
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", "", 0, lnWrapText, 0)
ENDIF
REPLACE xl_cells.cellxfs WITH lnCellXfsId IN xl_cells
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, 0, 0, 0, 0, "", "", 0, lnWrapText, 0)
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_NONE, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcellwordwraprange && Sets the word wrap for a range of cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tlWordWrap
LOCAL lnRow, lnCol, llReturn
IF PCOUNT() < 7 .OR. VARTYPE(tlWordWrap) != "L" .OR. this.IsCellReferenceInvalid(tnBegRow, tnBegCol) .OR. this.IsCellReferenceInvalid(tnEndRow, tnEndCol)
RETURN False
ENDIF
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN False
ENDIF
llReturn = True
FOR lnRow=tnBegRow TO tnEndRow
FOR lnCol=tnBegCol TO tnEndCol
IF !this.SetCellWordWrap(tnWB, tnSheet, lnRow, lnCol, tlWordWrap)
llReturn = False
EXIT
ENDIF
ENDFOR
ENDFOR
RETURN llReturn
ENDPROC
PROCEDURE setcolumnbestfit && Set the column to best fit
LPARAMETERS tnWB, tnSheet, tnColumn, tlBestFit
LOCAL llReturn, lcAlias
IF PCOUNT() < 4
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetColWidthKeyExpr(tnWB, tnSheet, tnColumn), "xl_colwidths", "shcolumn")
REPLACE xl_colwidths.bestfit WITH tlBestFit IN xl_colwidths
ELSE
INSERT INTO xl_colwidths (workbook, sheet, column, bestfit) VALUES (tnWB, tnSheet, tnColumn, tlBestFit)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcolumnwidth && Sets the column width
LPARAMETERS tnWB, tnSheet, tnColumn, tnWidth
LOCAL llReturn, lcAlias
IF PCOUNT() < 4 .OR. VARTYPE(tnWidth) != "N"
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetColWidthKeyExpr(tnWB, tnSheet, tnColumn), "xl_colwidths", "shcolumn")
REPLACE xl_colwidths.width WITH tnWidth IN xl_colwidths
ELSE
INSERT INTO xl_colwidths (workbook, sheet, column, width, bestfit) VALUES (tnWB, tnSheet, tnColumn, tnWidth, False)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setcolumnwidthrange && Sets the column width for a range of columns
LPARAMETERS tnWB, tnSheet, tnBegCol, tnEndCol, tnWidth
LOCAL lnCol, llReturn
IF PCOUNT() < 5
RETURN False
ENDIF
IF tnBegCol > tnEndCol
RETURN False
ENDIF
llReturn = True
FOR lnCol=tnBegCol TO tnEndCol
IF !this.SetColumnWidth(tnWB, tnSheet, lnCol, tnWidth)
llReturn = False
EXIT
ENDIF
ENDFOR
RETURN llReturn
ENDPROC
PROCEDURE setcustompapersize && Sets the paper size based on custom dimensions
LPARAMETERS tnWB, tnSheet, tnWidth, tnHeight, tcDimen
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF PCOUNT() = 5 .AND. this.GetSheetRecord(tnWB, tnSheet)
DO CASE
CASE tnWidth=0 .OR. tnHeight=0
REPLACE xl_sheets.paperwidth WITH 0, ;
xl_sheets.paperheight WITH 0, ;
xl_sheets.paperdimen WITH "" IN xl_sheets
llReturn = True
CASE tnWidth>0 .AND. tnHeight>0 .AND. INLIST(tcDimen, "mm", "in")
REPLACE xl_sheets.paperwidth WITH tnWidth, ;
xl_sheets.paperheight WITH tnHeight, ;
xl_sheets.paperdimen WITH LOWER(tcDimen) IN xl_sheets
llReturn = True
OTHERWISE
llReturn = False
ENDCASE
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setdefaultborder && Sets the default border style for the workbook
LPARAMETERS tnWB, tcLStyle, tnLColor, tcRStyle, tnRColor, tcTStyle, tnTColor, tcBStyle, tnBColor, tcDStyle, tnDColor, tnDiagDn, tnDiagUp
LOCAL lcAlias
IF PCOUNT() < 2
RETURN False
ENDIF
IF VARTYPE(tcLStyle) != "C"
tcLStyle = BORDER_STYLE_NONE
ENDIF
lcAlias = ALIAS()
DO CASE
CASE PCOUNT() = 2
tnLColor = 0
tcRStyle = tcLStyle
tnRColor = 0
tcTStyle = tcLStyle
tnTColor = 0
tcBStyle = tcLStyle
tnBColor = 0
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 3
tcRStyle = tcLStyle
tnRColor = 0
tcTStyle = tcLStyle
tnTColor = 0
tcBStyle = tcLStyle
tnBColor = 0
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 4
tnRColor = 0
tcTStyle = tcLStyle
tnTColor = 0
tcBStyle = tcLStyle
tnBColor = 0
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 5
tcTStyle = tcLStyle
tnTColor = 0
tcBStyle = tcLStyle
tnBColor = 0
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 6
tnTColor = 0
tcBStyle = tcLStyle
tnBColor = 0
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 7
tcBStyle = tcLStyle
tnBColor = 0
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 8
tnBColor = 0
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 9
tcDStyle = tcLStyle
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 10
tnDColor = 0
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 11
tnDiagDn = 0
tnDiagUp = 0
CASE PCOUNT() = 12
tnDiagUp = 0
ENDCASE
IF VARTYPE(tnLColor) != "N"
tnLColor = 0
ENDIF
IF VARTYPE(tcRStyle) != "C"
tcRStyle = tcLStyle
ENDIF
IF VARTYPE(tnRColor) != "N"
tnRColor = 0
ENDIF
IF VARTYPE(tcTStyle) != "C"
tcTStyle = tcLStyle
ENDIF
IF VARTYPE(tnTColor) != "N"
tnTColor = 0
ENDIF
IF VARTYPE(tcBStyle) != "C"
tcBStyle = tcLStyle
ENDIF
IF VARTYPE(tnBColor) != "N"
tnBColor = 0
ENDIF
IF VARTYPE(tcDStyle) != "C"
tcDStyle = tcLStyle
ENDIF
IF VARTYPE(tnDColor) != "N"
tnDColor = 0
ENDIF
IF VARTYPE(tnDiagDn) != "N"
tnDiagDn = 0
ENDIF
IF VARTYPE(tnDiagUp) != "N"
tnDiagUp = 0
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(0), "xl_borders", "id")
REPLACE xl_borders.lstyle WITH tcLStyle, ;
xl_borders.lcolor WITH tnLColor, ;
xl_borders.rstyle WITH tcRStyle, ;
xl_borders.rcolor WITH tnRColor, ;
xl_borders.tstyle WITH tcTStyle, ;
xl_borders.tcolor WITH tnTColor, ;
xl_borders.bstyle WITH tcBStyle, ;
xl_borders.bcolor WITH tnBColor, ;
xl_borders.dstyle WITH tcDStyle, ;
xl_borders.dcolor WITH tnDColor, ;
xl_borders.diagdn WITH tnDiagDn, ;
xl_borders.diagup WITH tnDiagUp IN xl_borders
ELSE
INSERT INTO xl_borders (workbook, id, lstyle, lcolor, rstyle, rcolor, tstyle, tcolor, bstyle, bcolor, dstyle, dcolor, diagdn, diagup) ;
VALUES (tnWB, 0, tcLStyle, tnLColor, tcRStyle, tnRColor, tcTStyle, tnTColor, tcBStyle, tnBColor, tcDStyle, tnDColor, tnDiagDn, tnDiagUp)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN True
ENDPROC
PROCEDURE setdefaultfill && Sets the default fill for the workbook
LPARAMETERS tnWB, tcPatternType, tnFColor, tnBColor
LOCAL lnFIndex, lnBIndex, lcAlias
IF PCOUNT() < 2
RETURN False
ENDIF
lcAlias = ALIAS()
IF VARTYPE(tcPatternType) != "C"
tcPatternType = FILL_STYLE_NONE
ENDIF
DO CASE
CASE PCOUNT() = 2
tnFColor = 0
lnFIndex = 0
tnBColor = 0
lnBIndex = 0
CASE PCOUNT() = 3
tnBColor = 0
lnBIndex = 64
ENDCASE
IF VARTYPE(tnFColor) != "N"
tnFColor = 0
ENDIF
IF VARTYPE(tnBColor) != "N"
tnBColor = RGB(255,255,255)
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(0), "xl_fills", "id")
REPLACE xl_fills.fgcolor WITH tnFColor, ;
xl_fills.bgcolor WITH tnBColor, ;
xl_fills.patttype WITH tcPatternType, ;
xl_fills.theme WITH 0, ;
xl_fills.tint WITH 0, ;
xl_fills.fgindexed WITH 0, ;
xl_fills.bgindexed WITH 0 IN xl_fills
ELSE
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed) ;
VALUES (tnWB, 0, tnFColor, tnBColor, tcPatternType, 0, 0, lnFIndex, lnBIndex)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN True
ENDPROC
PROCEDURE setdefaultfont && Sets the default font for the workbook
LPARAMETERS tnWB, tcFontName, tnSize, tlBold, tlItalic, tnColor, tcUline, tlStrkthr, tcFVPos, tnTheme, tnTint, tnIndexed
LOCAL lcAlias
IF PCOUNT() < 2
RETURN False
ENDIF
lcAlias = ALIAS()
DO CASE
CASE PCOUNT() = 2
tnSize = 11
tlBold = False
tlItalic = False
tnColor = 0
tcUline = ""
tlStrkthr = False
tcFVPos = ""
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 3
tlBold = False
tlItalic = False
tnColor = 0
tcUline = ""
tlStrkthr = False
tcFVPos = ""
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 4
tlItalic = False
tnColor = 0
tcUline = ""
tlStrkthr = False
tcFVPos = ""
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 5
tnColor = 0
tcUline = ""
tlStrkthr = False
tcFVPos = ""
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 6
tcUline = ""
tlStrkthr = False
tcFVPos = ""
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 7
tlStrkthr = False
tcFVPos = ""
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 8
tcFVPos = ""
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 9
tnTheme = 0
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 10
tnTint = 0
tnIndexed = 0
CASE PCOUNT() = 11
tnIndexed = 0
ENDCASE
IF VARTYPE(tcFontName) != "C"
tcFontName = "Calibri"
ENDIF
IF VARTYPE(tnSize) != "N"
tnSize = 11
ENDIF
IF VARTYPE(tlBold) != "L"
tlBold = False
ENDIF
IF VARTYPE(tlItalic) != "L"
tlItalic = False
ENDIF
IF VARTYPE(tnColor) != "N"
tnColor = 0
ENDIF
IF VARTYPE(tcUline) != "C"
tcUline = ""
ENDIF
IF VARTYPE(tlStrkthr) != "L"
tlStrkthr = False
ENDIF
IF VARTYPE(tcFVPos) != "C"
tcFVPos = ""
ENDIF
IF VARTYPE(tnTheme) != "N"
tnTheme = 0
ENDIF
IF VARTYPE(tnTint) != "N"
tnTint = 0
ENDIF
IF VARTYPE(tnIndexed) != "N"
tnTint = 0
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(0), "xl_fonts", "id")
REPLACE xl_fonts.fname WITH tcFontName, ;
xl_fonts.fsize WITH tnSize, ;
xl_fonts.fbold WITH tlBold, ;
xl_fonts.fitalic WITH tlItalic, ;
xl_fonts.fcolor WITH tnColo , ;
xl_fonts.uline WITH tcUline, ;
xl_fonts.strkthr WITH tlStrkthr, ;
xl_fonts.fvpos WITH tcFVPos, ;
xl_fonts.theme WITH tnTheme, ;
xl_fonts.tint WITH tnTint, ;
xl_fonts.indexed WITH tnIndexed IN xl_fonts
ELSE
INSERT INTO xl_fonts (workbook, id, fname, fsize, fbold, fitalic, fcolor, uline, strkthr, fvpos, theme, tint, indexed) ;
VALUES (tnWB, 0, tcFontName, tnSize, tlBold, tlItalic, tnColor, tcUline, tlStrkthr, tcFVPos, tnTheme, tnTint, tnIndexed)
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN true
ENDPROC
PROCEDURE setheaderfootersetup && Sets the header and footer setup for the sheet
LPARAMETERS tnWB, tnSheet, tlAlignMargin, tlDiffFirstPg, tlDiffOddEven, tlScaleWDoc
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF PCOUNT() = 6 .AND. this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet), "xl_hdrfooterdefn", "wbsheet")
REPLACE xl_hdrfooterdefn.alignmargin WITH tlAlignMargin, ;
xl_hdrfooterdefn.difffirstpg WITH tlDiffFirstPg, ;
xl_hdrfooterdefn.diffoddeven WITH tlDiffOddEven, ;
xl_hdrfooterdefn.scalewdoc WITH tlScaleWDoc IN xl_hdrfooterdefn
ELSE
INSERT INTO xl_hdrfooterdefn (workbook, sheet, alignmargin, difffirstpg, diffoddeven, scalewdoc) ;
VALUES (tnWB, tnSheet, tlAlignMargin, tlDiffFirstPg, tlDiffOddEven, tlScaleWDoc)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setheaderfootertext && Sets the header/footer text for the sheet
LPARAMETERS tnWB, tnSheet, tnPage, tnSection, tcText, tcFontName, tnFontSize, tnFontEffect, tnFontColor
LOCAL llReturn, lcAlias
DO CASE
CASE PCOUNT() < 5
RETURN False
CASE PCOUNT() = 5
tcFontName = ""
tnFontSize = 0
tnFontEffect = 0
tnFontColor = 0
CASE PCOUNT() = 6
tnFontSize = 0
tnFontEffect = 0
tnFontColor = 0
CASE PCOUNT() = 7
tnFontEffect = 0
tnFontColor = 0
CASE PCOUNT() = 8
tnFontColor = 0
ENDCASE
IF VARTYPE(tcFontName) != "C"
tcFontName = ""
ENDIF
IF VARTYPE(tnFontSize) != "N"
tnFontSize = 0
ENDIF
IF VARTYPE(tnFontEffect) != "N"
tnFontEffect = 0
ENDIF
IF VARTYPE(tnFontColor) != "N"
tnFontColor = 0
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet), "xl_hdrfooterdefn", "wbsheet")
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, tnPage, tnSection), "xl_hdrfootertext", "hdrfootr")
REPLACE xl_hdrfootertext.text WITH tcText, ;
xl_hdrfootertext.fontname WITH tcFontName, ;
xl_hdrfootertext.fontsize WITH tnFontSize, ;
xl_hdrfootertext.fontstyle WITH tnFontEffect, ;
xl_hdrfootertext.fontcolor WITH tnFontColor IN xl_hdrfootertext
ELSE
INSERT INTO xl_hdrfootertext (workbook, sheet, page, section, text, fontname, fontsize, fontstyle, fontcolor) ;
VALUES (tnWB, tnSheet, tnPage, tnSection, tcText, tcFontName, tnFontSize, tnFontEffect, tnFontColor)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROTECTED PROCEDURE setlastid && Sets the last used Id Value for strings, borders, fills, fonts, and cellxfs
LPARAMETERS tnWB, tnLastId, tcCursor
LOCAL lnNdx
DO CASE
CASE tcCursor = "xl_borders"
lnNdx = ASCAN(this.LastBorderId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastBorderId[lnNdx, 2] = tnLastId
ELSE
IF this.LastBorderId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastBorderId, 1) + 1
ENDIF
DIMENSION this.LastBorderId[lnNdx, 2]
this.LastBorderId[lnNdx, 1] = tnWB
this.LastBorderId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_cellxfs"
lnNdx = ASCAN(this.LastCellXfsId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastCellXfsId[lnNdx, 2] = tnLastId
ELSE
IF this.LastCellXfsId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastCellXfsId, 1) + 1
ENDIF
DIMENSION this.LastCellXfsId[lnNdx, 2]
this.LastCellXfsId[lnNdx, 1] = tnWB
this.LastCellXfsId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_fills"
lnNdx = ASCAN(this.LastFillId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastFillId[lnNdx, 2] = tnLastId
ELSE
IF this.LastFillId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastFillId, 1) + 1
ENDIF
DIMENSION this.LastFillId[lnNdx, 2]
this.LastFillId[lnNdx, 1] = tnWB
this.LastFillId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_fonts"
lnNdx = ASCAN(this.LastFontId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastFontId[lnNdx, 2] = tnLastId
ELSE
IF this.LastFontId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastFontId, 1) + 1
ENDIF
DIMENSION this.LastFontId[lnNdx, 2]
this.LastFontId[lnNdx, 1] = tnWB
this.LastFontId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_ndxcolors"
lnNdx = ASCAN(this.LastIndexColorId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastIndexColorId[lnNdx, 2] = tnLastId
ELSE
IF this.LastIndexColorId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastIndexColorId, 1) + 1
ENDIF
DIMENSION this.LastIndexColorId[lnNdx, 2]
this.LastIndexColorId[lnNdx, 1] = tnWB
this.LastIndexColorId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_mrucolors"
lnNdx = ASCAN(this.LastMruColorId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastMruColorId[lnNdx, 2] = tnLastId
ELSE
IF this.LastMruColorId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastMruColorId, 1) + 1
ENDIF
DIMENSION this.LastMruColorId[lnNdx, 2]
this.LastMruColorId[lnNdx, 1] = tnWB
this.LastMruColorId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_numfmts"
lnNdx = ASCAN(this.LastNumFmtId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastNumFmtId[lnNdx, 2] = tnLastId
ELSE
IF this.LastNumFmtId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastNumFmtId, 1) + 1
ENDIF
DIMENSION this.LastNumFmtId[lnNdx, 2]
this.LastNumFmtId[lnNdx, 1] = tnWB
this.LastNumFmtId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_relationships"
lnNdx = ASCAN(this.LastRelationId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastRelationId[lnNdx, 2] = tnLastId
ELSE
IF this.LastRelationId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastRelationId, 1) + 1
ENDIF
DIMENSION this.LastRelationId[lnNdx, 2]
this.LastRelationId[lnNdx, 1] = tnWB
this.LastRelationId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_sheets"
lnNdx = ASCAN(this.LastSheetId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastSheetId[lnNdx, 2] = tnLastId
ELSE
IF this.LastSheetId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastSheetId, 1) + 1
ENDIF
DIMENSION this.LastSheetId[lnNdx, 2]
this.LastSheetId[lnNdx, 1] = tnWB
this.LastSheetId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_strings"
lnNdx = ASCAN(this.LastStringId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastStringId[lnNdx, 2] = tnLastId
ELSE
IF this.LastStringId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastStringId, 1) + 1
ENDIF
DIMENSION this.LastStringId[lnNdx, 2]
this.LastStringId[lnNdx, 1] = tnWB
this.LastStringId[lnNdx, 2] = tnLastId
ENDIF
ENDCASE
ENDPROC
PROCEDURE setpapersize && Sets the paper size for the selected sheet
LPARAMETERS tnWB, tnSheet, tnPaperSize
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
IF BETWEEN(tnPaperSize, 0, 118)
REPLACE xl_sheets.papersize WITH tnPaperSize IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setprintfittoheight && Number of vertical pages to fit on for printing
LPARAMETERS tnWB, tnSheet, tnFitToHeight
LOCAL llReturn
lcAlias = ALIAS()
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
IF INT(tnFitToHeight) >= 0
REPLACE xl_sheets.fittoheight WITH INT(tnFitToHeight) IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setprintfittowidth && Number of horizontal pages to fit on for printing
LPARAMETERS tnWB, tnSheet, tnFitToWidth
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
IF INT(tnFitToWidth) >= 0
REPLACE xl_sheets.fittowidth WITH INT(tnFitToWidth) IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setprintorientation && Sets the printer orientation for sheet output
LPARAMETERS tnWB, tnSheet, tnOrientation
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.prnorient WITH tnOrientation IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setrowheight && Sets the row height
LPARAMETERS tnWB, tnSheet, tnRow, tnHeight
LOCAL llReturn, lcAlias
IF PCOUNT() < 4 .OR. VARTYPE(tnHeight) != "N"
RETURN False
ENDIF
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetRowHeightKeyExpr(tnWB, tnSheet, tnRow), "xl_rowheights", "shrow")
REPLACE xl_rowheights.height WITH tnHeight IN xl_rowheights
ELSE
INSERT INTO xl_rowheights (workbook, sheet, row, height) VALUES (tnWB, tnSheet, tnRow, tnHeight)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setrowheightrange && Sets the row height for a range of rows
LPARAMETERS tnWB, tnSheet, tnBegRow, tnEndRow, tnHeight
LOCAL lnRow, llReturn
IF PCOUNT() < 5
RETURN False
ENDIF
IF tnBegRow > tnEndRow
RETURN False
ENDIF
llReturn = True
FOR lnRow=tnBegRow TO tnEndRow
IF !this.SetRowHeight(tnWB, tnSheet, lnRow, tnHeight)
llReturn = False
EXIT
ENDIF
ENDFOR
RETURN llReturn
ENDPROC
PROTECTED PROCEDURE setrowmaxcolumn && Sets the value for the maximum cell column in a row
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnCellRow), "xl_rows", "id")
IF xl_rows.maxcol < tnCellCol
REPLACE xl_rows.maxcol WITH tnCellCol IN xl_rows
ENDIF
ELSE
INSERT INTO xl_rows (workbook, sheet, row, maxcol) VALUES (tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
ENDPROC
PROCEDURE setsheetmargins && Sets the sheet margin values
LPARAMETERS tnWB, tnSheet, tnLeft, tnRight, tnTop, tnbot, tnHeader, tnFooter
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF PCOUNT() = 8 .AND. this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.mleft WITH tnLeft, ;
xl_sheets.mright WITH tnRight, ;
xl_sheets.mtop WITH tnTop, ;
xl_sheets.mbot WITH tnbot, ;
xl_sheets.mheader WITH tnHeader, ;
xl_sheets.mfooter WITH tnFooter IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setsheetscale && Sets the print scale; must be between 10 and 400; i.e. 10=10%, 100=100%, etc.
LPARAMETERS tnWB, tnSheet, tnScale
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
IF BETWEEN(INT(tnScale), 10, 400)
REPLACE xl_sheets.scale WITH INT(tnScale) IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE setsheetvisibility && Sets the sheet visibility
LPARAMETERS tnWB, tnSheet, tnVisiblity
LOCAL llReturn, lcAlias
llReturn = False
lcAlias = ALIAS()
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
IF BETWEEN(tnVisiblity, VISIBLE_SHEET_STATE, VERYHIDDEN_SHEET_STATE)
REPLACE xl_sheets.state WITH tnVisiblity IN xl_sheets
llReturn = True
ENDIF
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROTECTED PROCEDURE ttoc3 && Equlivalent of TTOC() function for pre VFP9 support
LPARAMETERS ttime
LOCAL lct
IF PCOUNT() < 1 OR VARTYPE(m.ttime) != "T"
RETURN
ENDIF
lct = TTOC(m.ttime,1)
RETURN LEFT(m.lct,4) + "-" + SUBSTR(m.lct,5,2) + "-" + SUBSTR(m.lct,7,2) + "T" + SUBSTR(m.lct,9,2) + ":" + SUBSTR(m.lct,11,2) + ":" + RIGHT(m.lct,2)
ENDPROC
PROCEDURE unfreezepanes && Removes the pane freeze from the sheet
LPARAMETERS tnWB, tnSheet
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
IF this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.xsplit WITH 0, ;
xl_sheets.ysplit WITH 0 IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE unmergedcells && Unmerges merged cells
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol
LOCAL llReturn, lcAlias
lcAlias = ALIAS()
SELECT xl_mergecells
LOCATE FOR workbook=tnWB .AND. sheet=tnSheet .AND. begrow=tnBegRow .AND. begcol=tnBegCol .AND. endrow=tnEndRow .AND. endcol=tnEndCol .AND. !DELETED()
IF FOUND()
DELETE IN xl_mergecells
llReturn = True
ELSE
llReturn = False
ENDIF
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llReturn
ENDPROC
PROTECTED PROCEDURE writeasinlineformattedstring && Writes the string as formatted in-line
LPARAMETERS thFile, tnRow, tnCol, txCellValue
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="inlineStr">')
FWRITE(thFile, '<is>')
FWRITE(thFile, '<r>')
FWRITE(thFile, '<rPr>')
FWRITE(thFile, '<sz val="' + TRANSFORM(this.DefaultFontSize) + '"/>')
FWRITE(thFile, '<rFont val="' + this.DefaultFont + '"/>')
FWRITE(thFile, '</rPr>')
FWRITE(thFile, '<t>' + this.GetXMLString(txCellValue) + '</t>')
FWRITE(thFile, '</r>')
FWRITE(thFile, '</is>')
FWRITE(thFile, '</c>')
ENDPROC
PROTECTED PROCEDURE writeasinlinestring && Writes the value as an inlineStr value
LPARAMETERS thFile, tnRow, tnCol, txCellValue
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="inlineStr">')
FWRITE(thFile, '<is><t>' + this.GetXMLString(txCellValue) + '</t></is>')
FWRITE(thFile, '</c>')
ENDPROC
PROTECTED PROCEDURE writedirectcellformattedvalue && WriteDirectCellFormattedValue
LPARAMETERS thFile, tnRow, tnCol, txCellValue
DO CASE
CASE ISNULL(txCellValue)
RETURN
CASE INLIST(VARTYPE(txCellValue), "C", "D", "T") .AND. EMPTY(txCellValue)
RETURN
CASE VARTYPE(txCellValue) = DATA_TYPE_DATE
this.WriteAsInLineFormattedString(thFile, tnRow, tnCol, TRANSFORM(txCellValue))
CASE VARTYPE(txCellValue) = DATA_TYPE_DATETIME
this.WriteAsInLineFormattedString(thFile, tnRow, tnCol, TTOC(txCellValue))
CASE VARTYPE(txCellValue) = DATA_TYPE_LOGICAL
txCellValue = IIF(txCellValue, GETWORDNUM(this.TrueFalseValue, 1, "|"), GETWORDNUM(this.TrueFalseValue, 2, "|"))
this.WriteAsInLineFormattedString(thFile, tnRow, tnCol, txCellValue)
CASE VARTYPE(txCellValue) = DATA_TYPE_CURRENCY
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="n">')
FWRITE(thFile, '<v>' + TRANSFORM(MTON(txCellValue)) + '</v></c>')
CASE VARTYPE(txCellValue) = DATA_TYPE_CHAR
this.WriteAsInLineFormattedString(thFile, tnRow, tnCol, ALLTRIM(txCellValue))
CASE INLIST(VARTYPE(txCellValue), DATA_TYPE_INT, DATA_TYPE_FLOAT)
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="n">')
FWRITE(thFile, '<v>' + TRANSFORM(txCellValue) + '</v></c>')
OTHERWISE
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="inlineStr">')
FWRITE(thFile, '<is><t>Unsupported Field Type</t></is></c>')
ENDCASE
ENDPROC
PROTECTED PROCEDURE writedirectcellvalue && Writes the cell value directly to the sheets xml
LPARAMETERS thFile, tnRow, tnCol, txCellValue
DO CASE
CASE ISNULL(txCellValue)
RETURN
CASE INLIST(VARTYPE(txCellValue), "C", "D", "T") .AND. EMPTY(txCellValue)
RETURN
CASE VARTYPE(txCellValue) = DATA_TYPE_DATE
this.WriteAsInLineString(thFile, tnRow, tnCol, TRANSFORM(txCellValue))
CASE VARTYPE(txCellValue) = DATA_TYPE_DATETIME
this.WriteAsInLineString(thFile, tnRow, tnCol, TTOC(txCellValue))
CASE VARTYPE(txCellValue) = DATA_TYPE_LOGICAL
txCellValue = IIF(txCellValue, GETWORDNUM(this.TrueFalseValue, 1, "|"), GETWORDNUM(this.TrueFalseValue, 2, "|"))
this.WriteAsInLineString(thFile, tnRow, tnCol, txCellValue)
CASE VARTYPE(txCellValue) = DATA_TYPE_CURRENCY
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="n">')
FWRITE(thFile, '<v>' + TRANSFORM(MTON(txCellValue)) + '</v></c>')
CASE VARTYPE(txCellValue) = DATA_TYPE_CHAR
this.WriteAsInLineString(thFile, tnRow, tnCol, ALLTRIM(txCellValue))
CASE INLIST(VARTYPE(txCellValue), DATA_TYPE_INT, DATA_TYPE_FLOAT)
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="n">')
FWRITE(thFile, '<v>' + TRANSFORM(txCellValue) + '</v></c>')
OTHERWISE
FWRITE(thFile, '<c r="' + this.ColumnIndexToAscii(tnCol) + TRANSFORM(tnRow) + '" t="inlineStr">')
FWRITE(thFile, '<is><t>Unsupported Field Type</t></is></c>')
ENDCASE
ENDPROC
PROTECTED PROCEDURE writedirectxmls && Writes the workbook XMLs for direct table/grid to workbook output
LPARAMETERS tcPath, taSheetNames
LOCAL lhFile, lcFileName, loException, lcSheetName, lnSheet, lnNumSheets
EXTERNAL ARRAY taSheetNames
*-* Create the supporting XML files
loException = .NULL.
TRY
lnNumSheets = ALEN(taSheetNames, 1)
CATCH TO loException
ENDTRY
IF !ISNULL(loException)
RETURN False
ENDIF
TRY
lhFile = FCREATE(tcPath + "[Content_Types].xml")
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types">')
FWRITE(lhFile, '<Default Extension="rels" ContentType="application/vnd.openxmlformats-package.relationships+xml"/>')
FWRITE(lhFile, '<Default Extension="xml" ContentType="application/xml"/>')
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" PartName="/xl/workbook.xml"/>')
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml" PartName="/xl/styles.xml"/>')
FOR lnSheet=1 TO lnNumSheets
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" PartName="/xl/worksheets/sheet' + TRANSFORM(lnSheet) + '.xml"/>')
ENDFOR
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-package.core-properties+xml" PartName="/docProps/core.xml"/>')
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-officedocument.extended-properties+xml" PartName="/docProps/app.xml"/>')
FWRITE(lhFile, '</Types>')
FCLOSE(lhFile)
*-* Save the .rels XML
lhFile = FCREATE(tcPath + "_rels\.rels")
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">')
FWRITE(lhFile, '<Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/>')
FWRITE(lhFile, '<Relationship Id="rId2" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/>')
FWRITE(lhFile, '<Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/>')
FWRITE(lhFile, '</Relationships>')
FCLOSE(lhFile)
*-* Write the workbook relationships file
lhFile = FCREATE(tcPath + "xl\_rels\workbook.xml.rels")
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">')
FWRITE(lhFile, '<Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles" Target="styles.xml"/>')
FOR lnSheet=1 TO lnNumSheets
FWRITE(lhFile, '<Relationship Id="rId' + TRANSFORM(lnSheet+1) + '" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet" Target="worksheets/sheet' + TRANSFORM(lnSheet) + '.xml"/>')
ENDFOR
FWRITE(lhFile, '</Relationships>')
FCLOSE(lhFile)
*-* Save the app XML
lcFileName = tcPath + "docProps\app.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Properties xmlns="http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" xmlns:vt="http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes">')
FWRITE(lhFile, '<Application>ExcelXMLX Release ' + TRANSFORM(this.ExcelXlsxRelease) + '</Application>')
IF !EMPTY(this.CompanyName)
FWRITE(lhFile, '<Company>' + this.CompanyName + '</Company>')
ENDIF
FWRITE(lhFile, '</Properties>')
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
*-* Save the core XML
lcFileName = tcPath + "docProps\core.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<cp:coreProperties ')
FWRITE(lhFile, 'xmlns:cp="http://schemas.openxmlformats.org/package/2006/metadata/core-properties" ')
FWRITE(lhFile, 'xmlns:dc="http://purl.org/dc/elements/1.1/" ')
FWRITE(lhFile, 'xmlns:dcterms="http://purl.org/dc/terms/" ')
FWRITE(lhFile, 'xmlns:dcmitype="http://purl.org/dc/dcmitype/" ')
FWRITE(lhFile, 'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">')
IF !EMPTY(this.Title)
FWRITE(lhFile, '<dc:title>' + this.GetXMLString(this.Title) + '</dc:title>')
ENDIF
IF !EMPTY(this.Subject)
FWRITE(lhFile, '<dc:subject>' + this.GetXMLString(this.Subject) + '</dc:subject>')
ENDIF
IF !EMPTY(this.CreatorName)
FWRITE(lhFile, '<dc:creator>' + this.GetXMLString(this.CreatorName) + '</dc:creator>')
ENDIF
IF !EMPTY(this.UserName)
FWRITE(lhFile, '<cp:lastModifiedBy>' + this.GetXMLString(this.UserName) + '</cp:lastModifiedBy>')
ENDIF
IF VERSION(5) < 900
FWRITE(lhFile, '<dcterms:created xsi:type="dcterms:W3CDTF">' + this.TTOC3(DATETIME()) + 'Z</dcterms:created>')
FWRITE(lhFile, '<dcterms:modified xsi:type="dcterms:W3CDTF">' + this.TTOC3(DATETIME()) + 'Z</dcterms:modified>')
ELSE
FWRITE(lhFile, '<dcterms:created xsi:type="dcterms:W3CDTF">' + TTOC(DATETIME(), 3) + 'Z</dcterms:created>')
FWRITE(lhFile, '<dcterms:modified xsi:type="dcterms:W3CDTF">' + TTOC(DATETIME(), 3) + 'Z</dcterms:modified>')
ENDIF
FWRITE(lhFile, '</cp:coreProperties>')
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
*-* Save the styles XML
lcFileName = tcPath + "xl\styles.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<styleSheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" ')
FWRITE(lhFile, 'xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" ')
FWRITE(lhFile, 'mc:Ignorable="x14ac" xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">')
FWRITE(lhFile, '<fonts count="1" x14ac:knownFonts="1"><font><sz val="11"/><color theme="1"/><name val="Calibri"/><family val="2"/><scheme val="minor"/></font></fonts>')
FWRITE(lhFile, '<fills count="2"><fill><patternFill patternType="none"/></fill><fill><patternFill patternType="gray125"/></fill></fills>')
FWRITE(lhFile, '<borders count="1"><border><left/><right/><top/><bottom/><diagonal/></border></borders>')
FWRITE(lhFile, '<cellStyleXfs count="1"><xf numFmtId="0" fontId="0" fillId="0" borderId="0"/></cellStyleXfs>')
FWRITE(lhFile, '<cellXfs count="1"><xf numFmtId="0" fontId="0" fillId="0" borderId="0" xfId="0"/></cellXfs>')
FWRITE(lhFile, '<cellStyles count="1"><cellStyle name="Normal" xfId="0" builtinId="0"/></cellStyles>')
FWRITE(lhFile, '</styleSheet>')
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
*-* Write the workbook XML
lcFileName = tcPath + "xl\workbook.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'+ LF)
FWRITE(lhFile, '<workbook xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships">')
FWRITE(lhFile, '<sheets>')
FOR lnSheet=1 TO lnNumSheets
IF EMPTY(taSheetNames[lnSheet])
lcSheetName = "Sheet" + TRANSFORM(lnSheet)
ELSE
lcSheetName = taSheetNames[lnSheet]
ENDIF
FWRITE(lhFile, '<sheet name="' + lcSheetName + '" sheetId="' + TRANSFORM(lnSheet) + '" r:id="rId' + TRANSFORM(lnSheet+1) + '"/>')
ENDFOR
FWRITE(lhFile, '</sheets>')
FWRITE(lhFile, '<calcPr calcId="0"/>')
FWRITE(lhFile, '</workbook>')
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
CATCH TO loException
SET STEP ON
FCLOSE(lhFile)
this.ErrorLevelId = 18
RAISEEVENT(this, "OnShowErrorMessage", 18, "Unable to create workbook supporting XMLs")
ENDTRY
RETURN ISNULL(loException)
ENDPROC
PROTECTED PROCEDURE writerelationshipsxml && Writes the relationships xml file
LPARAMETERS tnWB, tcPath
LOCAL lhFile, lcBaseType, llSuccess
RAISEEVENT(this, "OnShowStatusMessage", 2, 5)
lcBaseType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/"
TRY
*-* Write the workbook relationships file
lhFile = FCREATE(tcPath + "xl\_rels\workbook.xml.rels")
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">')
SELECT xl_relationships
SCAN FOR workbook = tnWB
FWRITE(lhFile, '<Relationship Id="rId' + TRANSFORM(xl_relationships.relid) + '" Target="' + ALLTRIM(xl_relationships.target) + '" Type="' + lcBaseType + ALLTRIM(xl_relationships.reltype) + '"/>')
ENDSCAN
FWRITE(lhFile, '</Relationships>')
llSuccess = True
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 16
RAISEEVENT(this, "OnShowErrorMessage", 16, "Unable to create workbook.xml.rels")
FINALLY
FCLOSE(lhFile)
ENDTRY
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE writesheetxmls && Writes the Sheet XML files
LPARAMETERS tnWB, tnSheetNbr, tcPath
LOCAL llSuccess, lcAlias, lhFile, lcRow, lnMinCol, lnMaxCol, lnWidth, lnLastRow, lcDyDescent
LOCAL lcRowDefHt, lcFileName
*-* Write the sheet XML
lcAlias = ALIAS()
*-* Write the sheet
TRY
lcFileName = tcPath + "xl\worksheets\sheet" + TRANSFORM(tnSheetNbr) + ".xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
* lcDyDescent = ' x14ac:dyDescent="0.25"' && Uncomment to add back...
lcDyDescent = ''
lcRowDefHt = ' ht="30"'
*-* Write sheet XML header information
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"')
FWRITE(lhFile, ' xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships"')
FWRITE(lhFile, ' xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac"')
FWRITE(lhFile, ' xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">')
*-* Write the tab color definition if set
DO CASE
CASE xl_sheets.tabcolorndx > 0
FWRITE(lhFile, '<sheetPr codeName="Sheet' + TRANSFORM(tnSheetNbr) + '"><tabColor indexed="' + TRANSFORM(xl_sheets.tabcolorndx) + '"/></sheetPr>')
CASE !EMPTY(xl_sheets.tabcolorrgb)
FWRITE(lhFile, '<sheetPr codeName="Sheet' + TRANSFORM(tnSheetNbr) + '"><tabColor rgb="' + xl_sheets.tabcolorrgb + '"/></sheetPr>')
ENDCASE
*-* Verify cells have been written
SELECT xl_cells
LOCATE FOR workbook = tnWB .AND. sheet = xl_sheets.sheet .AND. !celldeleted
IF FOUND()
*-* Write the sheet view information which includes the freeze pane information
SELECT cel.sheet, MAX(cel.cellrow) AS maxrow, MAX(cel.cellcol) AS maxcol ;
FROM xl_cells AS cel ;
WHERE cel.workbook = tnWB ;
AND cel.sheet = xl_sheets.sheet ;
AND cel.celldeleted = False ;
GROUP BY 1 ;
INTO CURSOR t_max READWRITE
FWRITE(lhFile, '<dimension ref="A1:' + this.ColumnIndexToAscii(t_max.maxcol) + TRANSFORM(t_max.maxrow) + '"/>')
DO CASE
CASE xl_sheets.ysplit > 0 .AND. xl_sheets.xsplit = 0 && Freeze top row(s) only
FWRITE(lhFile, '<sheetViews><sheetView workbookViewId="0">')
lcRow = TRANSFORM(xl_sheets.ysplit+1)
FWRITE(lhFile, '<pane state="frozenSplit" activePane="bottomLeft" topLeftCell="A' + lcRow + '" ySplit="' + TRANSFORM(xl_sheets.ysplit) + '"/>')
FWRITE(lhFile, '<selection activeCell="A' + lcRow + '" sqref="A' + lcRow + '" pane="bottomLeft"/>')
CASE xl_sheets.ysplit = 0 .AND. xl_sheets.xsplit > 0 && Freeze side column(s) only
FWRITE(lhFile, '<sheetViews><sheetView workbookViewId="0">')
lcColumn = this.ColumnIndexToAscii(xl_sheets.xsplit+1)
FWRITE(lhFile, '<pane state="frozenSplit" activePane="bottomLeft" topLeftCell="' + lcColumn + '1" xSplit="' + TRANSFORM(xl_sheets.xsplit) + '"/>')
FWRITE(lhFile, '<selection activeCell="' + lcColumn + '1" sqref="' + lcColumn + '1" pane="topRight"/>')
CASE xl_sheets.ysplit > 0 .AND. xl_sheets.xsplit > 0 && Freeze both top row(s) and side column(s)
FWRITE(lhFile, '<sheetViews><sheetView workbookViewId="0">')
lcRow = TRANSFORM(xl_sheets.ysplit+1)
lcColumn = this.ColumnIndexToAscii(xl_sheets.xsplit+1)
FWRITE(lhFile, '<pane state="frozenSplit" activePane="bottomRight" topLeftCell="' + lcColumn + lcRow + ;
'" ySplit="' + TRANSFORM(xl_sheets.ysplit) + '" xSplit="' + TRANSFORM(xl_sheets.xsplit) + '"/>')
FWRITE(lhFile, '<selection activeCell="' + this.ColumnIndexToAscii(xl_sheets.xsplit) + '1" sqref="' + this.ColumnIndexToAscii(xl_sheets.xsplit) + '1" pane="topRight"/>')
FWRITE(lhFile, '<selection activeCell="' + this.ColumnIndexToAscii(xl_sheets.xsplit) + lcRow + '" sqref="' + this.ColumnIndexToAscii(xl_sheets.xsplit) + lcRow + '" pane="bottomLeft"/>')
FWRITE(lhFile, '<selection activeCell="' + lcColumn + lcRow + '" sqref="' + lcColumn + lcRow + '" pane="bottomRight"/>')
OTHERWISE
FWRITE(lhFile, '<sheetViews><sheetView workbookViewId="0"><selection activeCell="A1" sqref="A1"/>')
* FWRITE(lhFile, '<sheetViews><sheetView tabSelected="1" workbookViewId="0">')
ENDCASE
FWRITE(lhFile, '</sheetView></sheetViews>')
FWRITE(lhFile, '<sheetFormatPr defaultRowHeight="15"' + lcDyDescent + '/>')
*-* Write sheet Column widths
SELECT clm.column, clm.width, clm.bestfit FROM xl_colwidths AS clm ;
WHERE clm.workbook = tnWB ;
AND clm.sheet = xl_sheets.sheet ;
ORDER BY clm.column ;
INTO CURSOR t_colwidths READWRITE
IF _TALLY > 0
FWRITE(lhFile, '<cols>')
SELECT t_colwidths
GOTO TOP
lnMinCol = t_colwidths.column
lnMaxCol = t_colwidths.column
lnWidth = t_colwidths.width
SKIP IN t_colwidths
DO WHILE !EOF('t_colwidths')
DO CASE
* CASE t_colwidths.bestfit && Not yet working!!!
* FWRITE(lhFile, '<col min="' + TRANSFORM(t_colwidths.column) + '" max="' + TRANSFORM(t_colwidths.column) + '" bestFit="1" customWidth="1"/>')
CASE t_colwidths.width = lnWidth .AND. t_colwidths.column-1 = lnMinCol
lnMaxCol = t_colwidths.column
OTHERWISE
FWRITE(lhFile, '<col min="' + TRANSFORM(lnMinCol) + '" max="' + TRANSFORM(lnMaxCol) + ;
'" width="' + TRANSFORM(lnWidth+0.7109375) + '" customWidth="1"/>')
lnMinCol = t_colwidths.column
lnMaxCol = t_colwidths.column
lnWidth = t_colwidths.width
ENDCASE
SKIP IN t_colwidths
ENDDO
FWRITE(lhFile, '<col min="' + TRANSFORM(lnMinCol) + '" max="' + TRANSFORM(lnMaxCol) + '" width="' + TRANSFORM(lnWidth+0.7109375) + '" customWidth="1"/>')
FWRITE(lhFile, '</cols>')
ENDIF
USE IN SELECT('t_colwidths')
*-* Write sheet cell data values
FWRITE(lhFile, '<sheetData>')
* lnLastRow = 0
lnHeadRow = 0
SELECT xl_cells
SET ORDER TO TAG cellindex
SCAN FOR workbook = tnWB .AND. sheet = xl_sheets.sheet .AND. !celldeleted
*-* Write row header
IF lnHeadRow != xl_cells.cellrow
IF lnHeadRow != 0
FWRITE(lhFile, '</row>')
ENDIF
lnHeadRow = xl_cells.cellrow
lnMaxCol = this.GetRowMaxColumn(tnWB, xl_sheets.sheet, lnHeadRow)
IF SEEK(this.GetRowHeightKeyExpr(tnWB, xl_sheets.sheet, xl_cells.cellrow), "xl_rowheights", "shrow")
FWRITE(lhFile, '<row r="' + TRANSFORM(xl_cells.cellrow) + '" spans="1:' + TRANSFORM(lnMaxCol) + ;
'" ht="' + TRANSFORM(xl_rowheights.height) + '" customHeight="1">')
ELSE
FWRITE(lhFile, '<row r="' + TRANSFORM(xl_cells.cellrow) + '" spans="1:' + TRANSFORM(lnMaxCol) + '"' + lcRowDefHt + '>')
ENDIF
ENDIF
*-* Write columns
IF xl_cells.cellxfs > 0
lcStyle = ' s="' + TRANSFORM(xl_cells.cellxfs) + '"'
ELSE
lcStyle = ''
ENDIF
DO CASE
CASE xl_cells.datatype = DATA_TYPE_TIME
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '>')
FWRITE(lhFile, '<v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_DATE
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '>')
FWRITE(lhFile, '<v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_DATETIME
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '>')
FWRITE(lhFile, '<v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_LOGICAL
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + ' t="s"' + '>')
FWRITE(lhFile, '<v>' + TRANSFORM(xl_cells.stringid) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_CHAR
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + ' t="s"' + '>')
FWRITE(lhFile, '<v>' + TRANSFORM(xl_cells.stringid) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_INT
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '>')
FWRITE(lhFile, '<v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_FLOAT
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '>')
FWRITE(lhFile, '<v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_CURRENCY
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '>')
FWRITE(lhFile, '<v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_PERCENT
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '>')
FWRITE(lhFile, '<v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_FORMULA
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + ' t="str"' + '>')
FWRITE(lhFile, '<f>' + ALLTRIM(xl_cells.cellformula) + '</f><v>' + ALLTRIM(xl_cells.cellvalue) + '</v></c>')
CASE xl_cells.datatype = DATA_TYPE_NONE
IF !EMPTY(lcStyle)
FWRITE(lhFile, '<c r="' + this.ColumnIndexToAscii(xl_cells.cellcol) + TRANSFORM(xl_cells.cellrow) + '"' + lcStyle + '></c>')
ENDIF
ENDCASE
ENDSCAN
FWRITE(lhFile, '</row>')
FWRITE(lhFile, '</sheetData>')
SET ORDER TO
USE IN t_max
ELSE
*-* No cell data has been created/written
FWRITE(lhFile, '<dimension ref="A1"/>')
FWRITE(lhFile, '<sheetViews>')
FWRITE(lhFile, '<sheetView workbookViewId="0"/>')
FWRITE(lhFile, '</sheetViews>')
FWRITE(lhFile, '<sheetFormatPr defaultRowHeight="14.4"/>')
FWRITE(lhFile, '<sheetData/>')
ENDIF
*-* Write sheet merge data
SELECT mrg.begrow, mrg.begcol, mrg.endrow, mrg.endcol FROM xl_mergecells AS mrg ;
WHERE mrg.workbook = tnWB ;
AND mrg.sheet = xl_sheets.sheet ;
ORDER BY mrg.begrow ;
INTO CURSOR t_merge
IF _TALLY > 0
FWRITE(lhFile, '<mergeCells>')
SELECT t_merge
SCAN
FWRITE(lhFile, '<mergeCell ref="' + this.ColumnIndexToAscii(t_merge.begcol) + TRANSFORM(t_merge.begrow) + ':' + ;
this.ColumnIndexToAscii(t_merge.endcol) + TRANSFORM(t_merge.endrow) + '"/>')
ENDSCAN
FWRITE(lhFile, '</mergeCells>')
ENDIF
USE IN t_merge
*-* Write the cell validation data
SELECT xl_validation
COUNT FOR xl_validation.workbook = tnWB .AND. xl_validation.sheet = xl_sheets.sheet .AND. !DELETED() TO lnValidCnt
IF lnValidCnt > 0
FWRITE(lhFile, '<dataValidations count="' + TRANSFORM(lnValidCnt) + '">')
SCAN
SELECT xl.cellrow, xl.cellcol FROM xl_cells AS xl ;
WHERE BINTOC(xl.workbook)+BINTOC(xl.sheet)+BINTOC(xl.validndx) = BINTOC(tnWB)+BINTOC(xl_sheets.sheet)+BINTOC(xl_validation.validndx) ;
ORDER BY xl.cellrow, xl.cellcol ;
INTO CURSOR t_celllist
SELECT t_celllist
lcSqRef = ""
SCAN
lcSqRef = lcSqRef + this.ColumnIndexToAscii(t_celllist.cellcol) + TRANSFORM(t_celllist.cellrow) + " "
ENDSCAN
lcSqRef = ALLTRIM(lcSqRef)
DO CASE
CASE xl_validation.vtype = NONE_VALID_TYPE
lcValidationText = 'type="none"'
CASE xl_validation.vtype = WHOLE_VALID_TYPE
lcValidationText = 'type="whole"'
CASE xl_validation.vtype = DECIMAL_VALID_TYPE
lcValidationText = 'type="decimal"'
CASE xl_validation.vtype = LIST_VALID_TYPE
lcValidationText = 'type="list"'
CASE xl_validation.vtype = DATE_VALID_TYPE
lcValidationText = 'type="date"'
CASE xl_validation.vtype = TIME_VALID_TYPE
lcValidationText = 'type="time"'
CASE xl_validation.vtype = TXTLEN_VALID_TYPE
lcValidationText = 'type="textLength"'
CASE xl_validation.vtype = CUSTOM_VALID_TYPE
lcValidationText = 'type="custom"'
OTHERWISE
lcValidationText = 'type="none"'
ENDCASE
IF xl_validation.vstyle > 0
DO CASE
CASE xl_validation.vstyle = STOP_VALID_STYLE
lcValidationText = lcValidationText + ' errorStyle="stop"'
CASE xl_validation.vstyle = WARN_VALID_STYLE
lcValidationText = lcValidationText + ' errorStyle="warning"'
CASE xl_validation.vstyle = INFO_VALID_STYLE
lcValidationText = lcValidationText + ' errorStyle="information"'
ENDCASE
ENDIF
IF xl_validation.voperator > 0
DO CASE
CASE xl_validation.voperator = BETWEEN_VALID_OPER
lcValidationText = lcValidationText + ' operator="between"'
CASE xl_validation.voperator = NOTBETW_VALID_OPER
lcValidationText = lcValidationText + ' operator="notBetween"'
CASE xl_validation.voperator = EQUAL_VALID_OPER
lcValidationText = lcValidationText + ' operator="equal"'
CASE xl_validation.voperator = NOTEQUAL_VALID_OPER
lcValidationText = lcValidationText + ' operator="notEqual"'
CASE xl_validation.voperator = LESSTHAN_VALID_OPER
lcValidationText = lcValidationText + ' operator="lessThan"'
CASE xl_validation.voperator = LESSOREQUAL_VALID_OPER
lcValidationText = lcValidationText + ' operator="lessThanOrEqual"'
CASE xl_validation.voperator = GREATTHAN_VALID_OPER
lcValidationText = lcValidationText + ' operator="greaterThan"'
CASE xl_validation.voperator = GREATOREQUAL_VALID_OPER
lcValidationText = lcValidationText + ' operator="greaterThanOrEqual"'
ENDCASE
ENDIF
lcValidationText = lcValidationText + ' allowBlank="' + IIF(xl_validation.allowblank, '1', '0') + '"'
lcValidationText = lcValidationText + ' showInputMessage="' + IIF(xl_validation.showinpmsg, '1', '0') + '"'
lcValidationText = lcValidationText + ' showErrorMessage="' + IIF(xl_validation.showerrmsg, '1', '0') + '"'
IF !EMPTY(xl_validation.errtitle)
lcValidationText = lcValidationText + ' errorTitle="' + ALLTRIM(xl_validation.errtitle) + '"'
ENDIF
IF !EMPTY(xl_validation.errmsg)
lcValidationText = lcValidationText + ' error="' + ALLTRIM(xl_validation.errmsg) + '"'
ENDIF
IF !EMPTY(xl_validation.vprompt)
lcValidationText = lcValidationText + ' prompt="' + ALLTRIM(xl_validation.vprompt) + '"'
ENDIF
FWRITE(lhFile, '<dataValidation ' + lcValidationText + ' sqref="' + lcSqRef + '">')
IF xl_validation.formula
FWRITE(lhFile, '<formula1>' + ALLTRIM(xl_validation.formula1) + '</formula1>')
IF !EMPTY(xl_validation.formula2)
FWRITE(lhFile, '<formula2>' + ALLTRIM(xl_validation.formula2) + '</formula2>')
ENDIF
ELSE
FWRITE(lhFile, '<formula1>"' + ALLTRIM(xl_validation.formula1) + '"</formula1>')
IF !EMPTY(xl_validation.formula2)
FWRITE(lhFile, '<formula2>"' + ALLTRIM(xl_validation.formula2) + '"</formula2>')
ENDIF
ENDIF
FWRITE(lhFile, '</dataValidation>')
ENDSCAN
USE IN SELECT('t_celllist')
FWRITE(lhFile, '</dataValidations>')
ENDIF
*-* Write sheet margin data
FWRITE(lhFile, '<pageMargins left="' + RTRIM(TRANSFORM(xl_sheets.mleft), 1, '0') + '" right="' + RTRIM(TRANSFORM(xl_sheets.mright), 1, '0') + ;
'" top="' + RTRIM(TRANSFORM(xl_sheets.mtop), 1, '0') + '" bottom="' + RTRIM(TRANSFORM(xl_sheets.mbot), 1, '0') + ;
'" header="' + RTRIM(TRANSFORM(xl_sheets.mheader), 1, '0') + '" footer="' + RTRIM(TRANSFORM(xl_sheets.mfooter), 1, '0') + '"/>')
*-* Write the sheet page print setup
FWRITE(lhFile, '<pageSetup orientation="' + IIF(xl_sheets.prnorient=PORTRAIT_PRINT_ORIENTATION, 'portrait', 'landscape') + '"')
IF xl_sheets.paperwidth > 0 .AND. xl_sheets.paperheight > 0
FWRITE(lhFile, ' paperHeight="' + TRANSFORM(xl_sheets.paperheight) + xl_sheets.paperdimen + '"')
FWRITE(lhFile, ' paperWidth="' + TRANSFORM(xl_sheets.paperwidth) + xl_sheets.paperdimen + '"')
ELSE
IF xl_sheets.papersize > 0
FWRITE(lhFile, ' paperSize="' + TRANSFORM(xl_sheets.papersize) + '"')
ENDIF
ENDIF
DO CASE
CASE xl_sheets.fittowidth > 0 .AND. xl_sheets.fittoheight > 0
FWRITE(lhFile, ' fitToWidth="' + TRANSFORM(xl_sheets.fittowidth) + '"')
FWRITE(lhFile, ' fitToHeight="' + TRANSFORM(xl_sheets.fittoheight) + '"')
CASE xl_sheets.fittowidth = 0 .AND. xl_sheets.fittoheight > 0
FWRITE(lhFile, ' fitToHeight="' + TRANSFORM(xl_sheets.fittoheight) + '"')
CASE xl_sheets.fittowidth > 0 .AND. xl_sheets.fittoheight = 0
FWRITE(lhFile, ' fitToWidth="' + TRANSFORM(xl_sheets.fittowidth) + '"')
OTHERWISE
IF xl_sheets.scale != 100
FWRITE(lhFile, ' scale="' + TRANSFORM(xl_sheets.scale) + '"')
ENDIF
ENDCASE
FWRITE(lhFile, '/>')
*-* Write the header and footer for the sheet if defined
IF SEEK(BINTOC(tnWB)+BINTOC(xl_sheets.sheet), "xl_hdrfooterdefn", "wbsheet")
FWRITE(lhFile, '<headerFooter')
IF xl_hdrfooterdefn.alignmargin
FWRITE(lhFile, ' alignWithMargins="1"')
ENDIF
IF xl_hdrfooterdefn.difffirstpg
FWRITE(lhFile, ' differentFirst="1"')
ENDIF
IF xl_hdrfooterdefn.diffoddeven
FWRITE(lhFile, ' differentOddEven="1"')
ENDIF
IF xl_hdrfooterdefn.scalewdoc
FWRITE(lhFile, ' scaleWithDoc="1"')
ENDIF
FWRITE(lhFile, '>')
*-* Get the page header text
lcOddText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '<oddHeader>', lcOddText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '<oddHeader>', lcOddText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '<oddHeader>', lcOddText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcOddText)
lcOddText = lcOddText + '</oddHeader>'
ENDIF
lcEvenText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '<evenHeader>', lcEvenText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '<evenHeader>', lcEvenText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '<evenHeader>', lcEvenText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcEvenText)
lcEvenText = lcEvenText + '</evenHeader>'
ENDIF
lcSameText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '<oddHeader>', lcSameText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '<oddHeader>', lcSameText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '<oddHeader>', lcSameText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcSameText)
lcSameText = lcSameText + '</oddHeader>'
ENDIF
IF EMPTY(lcSameText)
lcHeaderText = lcOddText + lcEvenText
ELSE
lcHeaderText = lcSameText
ENDIF
*-* Get the page footer text
lcOddText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '<oddFooter>', lcOddText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '<oddFooter>', lcOddText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '<oddFooter>', lcOddText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcOddText)
lcOddText = lcOddText + '</oddFooter>'
ENDIF
lcEvenText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '<evenFooter>', lcEvenText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '<evenFooter>', lcEvenText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '<evenFooter>', lcEvenText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcEvenText)
lcEvenText = lcEvenText + '</evenFooter>'
ENDIF
lcSameText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '<oddFooter>', lcSameText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '<oddFooter>', lcSameText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '<oddFooter>', lcSameText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcSameText)
lcSameText = lcSameText + '</oddFooter>'
ENDIF
IF EMPTY(lcSameText)
lcFooterText = lcOddText + lcEvenText
ELSE
lcFooterText = lcSameText
ENDIF
*-* Get the first page text
lcFirstHdrText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcFirstHdrText = IIF(EMPTY(lcFirstHdrText), '<firstHeader>', lcFirstHdrText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcFirstHdrText = IIF(EMPTY(lcFirstHdrText), '<firstHeader>', lcFirstHdrText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcFirstHdrText = IIF(EMPTY(lcFirstHdrText), '<firstHeader>', lcFirstHdrText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcFirstHdrText)
lcFirstHdrText = lcFirstHdrText + '</firstHeader>'
ENDIF
lcFirstFtrText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcFirstFtrText = IIF(EMPTY(lcFirstFtrText), '<firstFooter>', lcFirstFtrText) + '&amp;L&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcFirstFtrText = IIF(EMPTY(lcFirstFtrText), '<firstFooter>', lcFirstFtrText) + '&amp;C&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, xl_sheets.sheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcFirstFtrText = IIF(EMPTY(lcFirstFtrText), '<firstFooter>', lcFirstFtrText) + '&amp;R&amp;' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcFirstFtrText)
lcFirstFtrText = lcFirstFtrText + '</firstFooter>'
ENDIF
*-* Write the header/footer text to XML
FWRITE(lhFile, lcHeaderText + lcFooterText + lcFirstHdrText + lcFirstFtrText + '</headerFooter>')
ENDIF
*-* Completed writing sheet
FWRITE(lhFile, '</worksheet>')
llSuccess = True
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 14
RAISEEVENT(this, "OnShowErrorMessage", 14, loException.message)
FINALLY
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
ENDTRY
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE writestringsxml && Writes the sharedStrings XML
LPARAMETERS tnWB, tcPath
LOCAL lcFileName, lhFile, lnTotCount, lnUniqueCnt, loException, llSuccess, lnRelId
RAISEEVENT(this, "OnShowStatusMessage", 2, 2)
TRY
SELECT xl_strformat
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB .AND. !DELETED() TO lnTotCount
SELECT xl_strings
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB .AND. !DELETED() TO lnUniqueCnt
lnTotCount = lnTotCount + lnUniqueCnt
IF lnUniqueCnt > 0
*-* If the shared strings xml has not been defined in the relationships, add it
IF !SEEK(BINTOC(tnWB)+"sharedStrings", "xl_relationships", "reltype")
lnRelId = this.GetNextId(tnWB, "xl_relationships")
INSERT INTO xl_relationships (workbook, relid, reltype, target) VALUES (tnWB, lnRelId, "sharedStrings", "sharedStrings.xml")
ENDIF
*-* Output the file
lcFileName = tcPath + "xl\sharedStrings.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>' + LF)
FWRITE(lhFile, '<sst xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" count="' + TRANSFORM(lnTotCount) + '" uniqueCount="' + TRANSFORM(lnUniqueCnt) + '">') && Change 19Jun2018: missplaced >
SELECT xl_strings
SCAN FOR workbook = tnWB .AND. !DELETED()
IF xl_strings.formatted
FWRITE(lhFile, '<si>')
SELECT xl_strformat
SCAN FOR workbook = tnWB .AND. id = xl_strings.id .AND. !DELETED()
FWRITE(lhFile, '<r>')
IF xl_strformat.fbold .OR. xl_strformat.fitalic .OR. xl_strformat.fcolor>0 .OR. !EMPTY(xl_strformat.fname) .OR. xl_strformat.fsize>0 ;
.OR. xl_strformat.strkthr .OR. !EMPTY(xl_strformat.fvpos) .OR. xl_strformat.theme>0 .OR. xl_strformat.indexed>0 .OR. xl_strformat.uline != UNDERLINE_NONE
FWRITE(lhFile, '<rPr>')
IF xl_strformat.fbold
FWRITE(lhFile, '<b/>')
ENDIF
IF xl_strformat.fitalic
FWRITE(lhFile, '<i/>')
ENDIF
IF xl_strformat.uline != UNDERLINE_NONE
FWRITE(lhFile, '<u/>')
ENDIF
IF xl_strformat.strkthr
FWRITE(lhFile, '<strike/>')
ENDIF
IF xl_strformat.fsize > 0
FWRITE(lhFile, '<sz val="' + TRANSFORM(xl_strformat.fsize) + '"/>')
ENDIF
DO CASE
CASE xl_strformat.fcolor > 0
FWRITE(lhFile, '<color rgb="' + this.ConvertColorToHex(xl_strformat.fcolor) +'"/>')
CASE xl_strformat.indexed > 0
FWRITE(lhFile, '<color indexed="' + TRANSFORM(xl_strformat.indexed) + '"/>')
CASE xl_strformat.theme > 0
FWRITE(lhFile, '<color theme="' + TRANSFORM(xl_strformat.theme) +'" tint="' + TRANSFORM(xl_strformat.tint, "99.999999999999999") + '"/>')
ENDCASE
IF !EMPTY(xl_strformat.fvpos)
FWRITE(lhFile, '<vertAlign val="' + ALLTRIM(xl_strformat.fvpos) + '"/>')
ENDIF
IF !EMPTY(xl_strformat.fname)
FWRITE(lhFile, '<rFont val="' + ALLTRIM(xl_strformat.fname) + '"/>')
ENDIF
FWRITE(lhFile, '</rPr>')
ENDIF
* IF xl_strformat.presvspace
FWRITE(lhFile, '<t xml:space="preserve">' + CHRTRAN(xl_strformat.stringxml, CHR(160), CHR(32)) + '</t>')
* ELSE
* FWRITE(lhFile, '<t>' + xl_strformat.stringxml + '</t>')
* ENDIF
FWRITE(lhFile, '</r>')
ENDSCAN
FWRITE(lhFile, '</si>')
SELECT xl_strings
ELSE
IF xl_strings.presvspace
FWRITE(lhFile, '<si><t xml:space="preserve">' + CHRTRAN(xl_strformat.stringxml, CHR(160), CHR(32)) + '</t></si>')
ELSE
FWRITE(lhFile, '<si><t>' + xl_strings.stringxml + '</t></si>')
ENDIF
ENDIF
ENDSCAN
SET ORDER TO
FWRITE(lhFile, '</sst>')
FCLOSE(lhFile)
STRTOFILE(STRCONV(FILETOSTR(lcFileName), 9), lcFileName, 4) && Save as UTF-8
ELSE
*-* No strings are assigned to cells; remove from relationships if present
DELETE FROM xl_relationships WHERE workbook = tnWB AND reltype = "sharedStrings"
ENDIF
llSuccess = True
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 15
RAISEEVENT(this, "OnShowErrorMessage", 15, loException.message)
ENDTRY
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE writestylesxml && Writes the styles.xml support file
LPARAMETERS tnWB, tcPath
LOCAL lcAlias, lcFileName, lhFile, lnNumFmtsId, lnRecCount, lcNumFmtId, lnRotation, llIndexedColors
LOCAL llMruColors
RAISEEVENT(this, "OnShowStatusMessage", 2, 3)
TRY
lcAlias = ALIAS()
lcFileName = tcPath + "xl\styles.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<styleSheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" ')
FWRITE(lhFile, 'xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" ')
FWRITE(lhFile, 'mc:Ignorable="x14ac" xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">')
*-* Get last used custom number format Id
lnNumFmtsId = 0
SELECT xl_numfmts
SET ORDER TO TAG sortorder
SCAN FOR workbook = tnWB .AND. xl_numfmts.id < 900
IF xl_numfmts.id > lnNumFmtsId
lnNumFmtsId = xl_numfmts.id
ENDIF
ENDSCAN
*-* Write the Number format section
COUNT FOR workbook = tnWB TO lnRecCount
FWRITE(lhFile, '<numFmts count="' + TRANSFORM(lnRecCount) + '">')
SCAN FOR workbook = tnWB
IF xl_numfmts.id > 900
lnNumFmtsId = lnNumFmtsId + 1
FWRITE(lhFile, '<numFmt numFmtId="' + TRANSFORM(lnNumFmtsId) + '" formatCode="' + ALLTRIM(xl_numfmts.formatxml) + '"/>')
REPLACE xl_numfmts.tempid WITH lnNumFmtsId IN xl_numfmts
ELSE
FWRITE(lhFile, '<numFmt numFmtId="' + TRANSFORM(xl_numfmts.id) + '" formatCode="' + ALLTRIM(xl_numfmts.formatxml) + '"/>')
REPLACE xl_numfmts.tempid WITH xl_numfmts.id IN xl_numfmts
ENDIF
ENDSCAN
FWRITE(lhFile, '</numFmts>')
SET ORDER TO
*-* Write the fonts section
SELECT xl_fonts
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB TO lnRecCount
FWRITE(lhFile, '<fonts count="' + TRANSFORM(lnRecCount) + '" x14ac:knownFonts="1">')
SCAN FOR workbook = tnWB
FWRITE(lhFile, '<font>')
FWRITE(lhFile, '<name val="' + ALLTRIM(xl_fonts.fname) + '"/>')
FWRITE(lhFile, '<sz val="' + TRANSFORM(xl_fonts.fsize) + '"/>')
IF xl_fonts.fbold
FWRITE(lhFile, '<b/>')
ENDIF
IF xl_fonts.fitalic
FWRITE(lhFile, '<i/>')
ENDIF
IF !EMPTY(xl_fonts.uline)
FWRITE(lhFile, '<u val="' + ALLTRIM(xl_fonts.uline) + '"/>')
ENDIF
IF xl_fonts.strkthr
FWRITE(lhFile, '<strike/>')
ENDIF
IF !EMPTY(xl_fonts.fvpos)
FWRITE(lhFile, '<vertAlign val="' + ALLTRIM(xl_fonts.fvpos) + '"/>')
ENDIF
DO CASE
CASE xl_fonts.fcolor > 0
FWRITE(lhFile, '<color rgb="' + this.ConvertColorToHex(xl_fonts.fcolor) + '"/>')
CASE xl_fonts.indexed > 0
FWRITE(lhFile, '<color indexed="' + TRANSFORM(xl_fonts.indexed) + '"/>')
CASE xl_fonts.theme > 0
FWRITE(lhFile, '<color theme="' + TRANSFORM(xl_fonts.theme) + '" tint="' + TRANSFORM(xl_fonts.tint, "99.999999999999999") + '"/>')
ENDCASE
FWRITE(lhFile, '</font>')
ENDSCAN
FWRITE(lhFile, '</fonts>')
SET ORDER TO
*-* Write the fills section
SELECT xl_fills
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB TO lnRecCount
FWRITE(lhFile, '<fills count="' + TRANSFORM(lnRecCount) + '">')
SCAN FOR workbook = tnWB
FWRITE(lhFile, '<fill><patternFill patternType="' + ALLTRIM(xl_fills.patttype) + '"')
DO CASE
CASE xl_fills.fgindexed > 0 .AND. xl_fills.bgindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<fgColor indexed="' + TRANSFORM(xl_fills.fgindexed) + '"/>')
FWRITE(lhFile, '<bgColor indexed="' + TRANSFORM(xl_fills.bgindexed) + '"/>')
FWRITE(lhFile, '</patternFill>')
CASE xl_fills.fgcolor > 0 .AND. xl_fills.bgindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<fgColor rgb="' + this.ConvertColorToHex(xl_fills.fgcolor) + '"/>')
FWRITE(lhFile, '<bgColor indexed="' + TRANSFORM(xl_fills.bgindexed) + '"/>')
FWRITE(lhFile, '</patternFill>')
CASE xl_fills.bgcolor > 0 .AND. xl_fills.fgindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<fgColor indexed="' + TRANSFORM(xl_fills.fgindexed) + '"/>')
FWRITE(lhFile, '<bgColor rgb="' + this.ConvertColorToHex(xl_fills.bgcolor) + '"/>')
FWRITE(lhFile, '</patternFill>')
CASE xl_fills.fgcolor > 0 .AND. xl_fills.bgcolor > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<fgColor rgb="' + this.ConvertColorToHex(xl_fills.fgcolor) + '"/>')
FWRITE(lhFile, '<bgColor rgb="' + this.ConvertColorToHex(xl_fills.bgcolor) + '"/>')
FWRITE(lhFile, '</patternFill>')
CASE xl_fills.theme > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<fgColor theme="' + TRANSFORM(xl_fills.theme) + '" tint="' + TRANSFORM(xl_fills.tint, "99.999999999999999") + '"/>')
FWRITE(lhFile, '<bgColor indexed="64"/>')
FWRITE(lhFile, '</patternFill>')
OTHERWISE
FWRITE(lhFile, '/>')
ENDCASE
FWRITE(lhFile, '</fill>')
ENDSCAN
FWRITE(lhFile, '</fills>')
*-* Write the borders section
SELECT xl_borders
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB TO lnRecCount
FWRITE(lhFile, '<borders count="' + TRANSFORM(lnRecCount) + '">')
SCAN FOR workbook = tnWB
FWRITE(lhFile, '<border' + IIF(xl_borders.diagdn=1, ' diagonalDown="1"', '') + IIF(xl_borders.diagup=1, ' diagonalUp="1"', '') +'>')
IF EMPTY(xl_borders.lstyle)
FWRITE(lhFile, '<left/>')
ELSE
IF xl_borders.lstyle = BORDER_STYLE_NONE
FWRITE(lhFile, '<left')
ELSE
FWRITE(lhFile, '<left style="' + ALLTRIM(xl_borders.lstyle) + '"')
ENDIF
DO CASE
CASE xl_borders.lcolor > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color rgb="' + this.ConvertColorToHex(xl_borders.lcolor) + '"/>')
FWRITE(lhFile, '</left>')
CASE xl_borders.lindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color indexed="' + TRANSFORM(xl_borders.lindexed) + '"/>')
FWRITE(lhFile, '</left>')
CASE xl_borders.ltheme > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color theme="' + TRANSFORM(xl_borders.ltheme) +'" tint="' + TRANSFORM(xl_borders.ltint, "99.999999999999999") + '"/>')
FWRITE(lhFile, '</left>')
OTHERWISE
FWRITE(lhFile, '/>')
ENDCASE
ENDIF
IF EMPTY(xl_borders.rstyle)
FWRITE(lhFile, '<right/>')
ELSE
IF xl_borders.rstyle = BORDER_STYLE_NONE
FWRITE(lhFile, '<right')
ELSE
FWRITE(lhFile, '<right style="' + ALLTRIM(xl_borders.rstyle) + '"')
ENDIF
DO CASE
CASE xl_borders.rcolor > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color rgb="' + this.ConvertColorToHex(xl_borders.rcolor) + '"/>')
FWRITE(lhFile, '</right>')
CASE xl_borders.rindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color indexed="' + TRANSFORM(xl_borders.rindexed) + '"/>')
FWRITE(lhFile, '</right>')
CASE xl_borders.rtheme > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color theme="' + TRANSFORM(xl_borders.rtheme) +'" tint="' + TRANSFORM(xl_borders.rtint, "99.999999999999999") + '"/>')
FWRITE(lhFile, '</right>')
OTHERWISE
FWRITE(lhFile, '/>')
ENDCASE
ENDIF
IF EMPTY(xl_borders.tstyle)
FWRITE(lhFile, '<top/>')
ELSE
IF xl_borders.tstyle = BORDER_STYLE_NONE
FWRITE(lhFile, '<top')
ELSE
FWRITE(lhFile, '<top style="' + ALLTRIM(xl_borders.tstyle) + '"')
ENDIF
DO CASE
CASE xl_borders.tcolor > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color rgb="' + this.ConvertColorToHex(xl_borders.tcolor) + '"/>')
FWRITE(lhFile, '</top>')
CASE xl_borders.tindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color indexed="' + TRANSFORM(xl_borders.tindexed) + '"/>')
FWRITE(lhFile, '</top>')
CASE xl_borders.ttheme > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color theme="' + TRANSFORM(xl_borders.ttheme) +'" tint="' + TRANSFORM(xl_borders.ttint, "99.999999999999999") + '"/>')
FWRITE(lhFile, '</top>')
OTHERWISE
FWRITE(lhFile, '/>')
ENDCASE
ENDIF
IF EMPTY(xl_borders.bstyle)
FWRITE(lhFile, '<bottom/>')
ELSE
IF xl_borders.bstyle = BORDER_STYLE_NONE
FWRITE(lhFile, '<bottom')
ELSE
FWRITE(lhFile, '<bottom style="' + ALLTRIM(xl_borders.bstyle) + '"')
ENDIF
DO CASE
CASE xl_borders.bcolor > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color rgb="' + this.ConvertColorToHex(xl_borders.bcolor) + '"/>')
FWRITE(lhFile, '</bottom>')
CASE xl_borders.bindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color indexed="' + TRANSFORM(xl_borders.bindexed) + '"/>')
FWRITE(lhFile, '</bottom>')
CASE xl_borders.btheme > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color theme="' + TRANSFORM(xl_borders.btheme) +'" tint="' + TRANSFORM(xl_borders.btint, "99.999999999999999") + '"/>')
FWRITE(lhFile, '</bottom>')
OTHERWISE
FWRITE(lhFile, '/>')
ENDCASE
ENDIF
IF EMPTY(xl_borders.dstyle)
FWRITE(lhFile, '<diagonal/>')
ELSE
IF xl_borders.dstyle = BORDER_STYLE_NONE
FWRITE(lhFile, '<diagonal')
ELSE
FWRITE(lhFile, '<diagonal style="' + ALLTRIM(xl_borders.dstyle) + '"')
ENDIF
DO CASE
CASE xl_borders.dcolor > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color rgb="' + this.ConvertColorToHex(xl_borders.dcolor) + '"/>')
FWRITE(lhFile, '</diagonal>')
CASE xl_borders.dindexed > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color indexed="' + TRANSFORM(xl_borders.dindexed) + '"/>')
FWRITE(lhFile, '</diagonal>')
CASE xl_borders.dtheme > 0
FWRITE(lhFile, '>')
FWRITE(lhFile, '<color theme="' + TRANSFORM(xl_borders.dtheme) +'" tint="' + TRANSFORM(xl_borders.dtint, "99.999999999999999") + '"/>')
FWRITE(lhFile, '</diagonal>')
OTHERWISE
FWRITE(lhFile, '/>')
ENDCASE
ENDIF
FWRITE(lhFile, '</border>')
ENDSCAN
FWRITE(lhFile, '</borders>')
*-* Write the cellStyleXfs section
*-* Write the cellXfs section
SELECT xl_cellxfs
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB TO lnRecCount
FWRITE(lhFile, '<cellXfs count="' + TRANSFORM(lnRecCount) + '">')
SCAN FOR workbook = tnWB
IF xl_cellxfs.numFmtId > 0 .AND. SEEK(BINTOC(tnWB)+BINTOC(xl_cellxfs.numFmtId), "xl_numfmts", "id")
lcNumFmtId = TRANSFORM(xl_numfmts.tempid)
ELSE
lcNumFmtId = TRANSFORM(xl_cellxfs.numFmtId)
ENDIF
FWRITE(lhFile, '<xf numFmtId="' + lcNumFmtId + '" fontId="' + TRANSFORM(xl_cellxfs.fontid) + ;
'" fillId="' + TRANSFORM(xl_cellxfs.fillid) + '" borderId="' + TRANSFORM(xl_cellxfs.borderid) + '"' + ;
IIF(lcNumFmtId = '0', '', ' applyNumberFormat="1"') + IIF(xl_cellxfs.fontid > 0, ' applyFont="1"', '') + ;
IIF(xl_cellxfs.fillid > 0, ' applyFill="1"', '') + IIF(xl_cellxfs.borderid > 0, ' applyBorder="1"', '') + ' applyAlignment="1"')
IF !EMPTY(xl_cellxfs.halign) .OR. !EMPTY(xl_cellxfs.valign) .OR. xl_cellxfs.wraptext > 0 .OR. xl_cellxfs.indent > 0 .OR. xl_cellxfs.rotation > 0
FWRITE(lhFile, '><alignment')
IF !EMPTY(xl_cellxfs.halign)
FWRITE(lhFile, ' horizontal="' + ALLTRIM(xl_cellxfs.halign) + '"')
ENDIF
IF !EMPTY(xl_cellxfs.valign)
FWRITE(lhFile, ' vertical="' + ALLTRIM(xl_cellxfs.valign) + '"')
ENDIF
IF xl_cellxfs.wraptext > 0
FWRITE(lhFile, ' wrapText="1"')
ENDIF
IF xl_cellxfs.indent > 0
FWRITE(lhFile, ' indent="' + TRANSFORM(xl_cellxfs.indent) + '"')
ENDIF
IF xl_cellxfs.rotation != 0
FWRITE(lhFile, ' textRotation="' + TRANSFORM(xl_cellxfs.rotation) + '"')
ENDIF
FWRITE(lhFile, '/></xf>')
ELSE
FWRITE(lhFile, '/>')
ENDIF
ENDSCAN
FWRITE(lhFile, '</cellXfs>')
*-* Write the colors section
llIndexedColors = SEEK(BINTOC(tnWB)+BINTOC(1), "xl_ndxcolors", "indexid")
llMruColors = SEEK(BINTOC(tnWB)+BINTOC(1), "xl_mrucolors", "indexid")
IF llIndexedColors .OR. llMruColors
FWRITE(lhFile, '<colors>')
IF llIndexedColors
FWRITE(lhFile, '<indexedColors>')
SELECT xl_ndxcolors
SET ORDER TO TAG indexid
SCAN FOR workbook = tnWB
FWRITE(lhFile, '<rgbColor rgb="' + xl_ndxcolors.rgbcolor + '"/>')
ENDSCAN
FWRITE(lhFile, '</indexedColors>')
ENDIF
IF llMruColors
FWRITE(lhFile, '<mruColors>')
SELECT xl_mrucolors
SET ORDER TO TAG indexid
SCAN FOR workbook = tnWB
FWRITE(lhFile, '<color rgb="' + xl_ndxcolors.rgbcolor + '"/>')
ENDSCAN
FWRITE(lhFile, '</mruColors>')
ENDIF
FWRITE(lhFile, '</colors>')
ENDIF
*-* Close the style sheet
FWRITE(lhFile, '</styleSheet>')
llSuccess = True
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 17
RAISEEVENT(this, "OnShowErrorMessage", 17, "Unable to create styles.xml")
FINALLY
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
ENDTRY
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE writesupportxmls && Writes the [Content_Types].xml, .rels, core.xml, workbook.xml.rels and app.xml files
LPARAMETERS tnWB, tcPath
LOCAL llSuccess, loException, lhFile, lnSheet, lnUniqueCnt, lcCurr, lcColor, lnTotCount, lcFileName, lcBaseContentType
RAISEEVENT(this, "OnShowStatusMessage", 2, 1)
TRY
lhFile = FCREATE(tcPath + "[Content_Types].xml")
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types">')
FWRITE(lhFile, '<Default Extension="rels" ContentType="application/vnd.openxmlformats-package.relationships+xml"/>')
FWRITE(lhFile, '<Default Extension="xml" ContentType="application/xml"/>')
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" PartName="/xl/workbook.xml"/>')
lcBaseContentType = '<Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.'
SELECT xl_relationships
SCAN FOR workbook = tnWB .AND. !DELETED()
DO CASE
CASE xl_relationships.reltype = "calcChain"
* FWRITE(lhFile, lcBaseContentType + 'calcChain+xml" PartName="/xl/calcChain.xml"/>')
CASE xl_relationships.reltype = "drawings"
* FWRITE(lhFile, lcBaseContentType + 'drawing+xml" PartName="/xl/drawings/drawing1.xml"/>')
CASE xl_relationships.reltype = "externalLink"
* FWRITE(lhFile, lcBaseContentType + 'externalLink+xml" PartName="/xl/externalLinks/externalLink1.xml"/>')
CASE xl_relationships.reltype = "sharedStrings"
FWRITE(lhFile, lcBaseContentType + 'sharedStrings+xml" PartName="/xl/sharedStrings.xml"/>')
CASE xl_relationships.reltype = "styles"
FWRITE(lhFile, lcBaseContentType + 'styles+xml" PartName="/xl/styles.xml"/>')
CASE xl_relationships.reltype = "theme"
* FWRITE(lhFile, lcBaseContentType + 'theme+xml" PartName="/xl/theme/theme1.xml"/>')
CASE xl_relationships.reltype = "worksheet"
FWRITE(lhFile, lcBaseContentType + 'worksheet+xml" PartName="/xl/worksheets/sheet' + TRANSFORM(xl_relationships.sheet) + '.xml"/>')
ENDCASE
ENDSCAN
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-package.core-properties+xml" PartName="/docProps/core.xml"/>')
FWRITE(lhFile, '<Override ContentType="application/vnd.openxmlformats-officedocument.extended-properties+xml" PartName="/docProps/app.xml"/>')
FWRITE(lhFile, '</Types>')
FCLOSE(lhFile)
*-* Save the .rels XML
lhFile = FCREATE(tcPath + "_rels\.rels")
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">')
FWRITE(lhFile, '<Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/>')
FWRITE(lhFile, '<Relationship Id="rId2" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/>')
FWRITE(lhFile, '<Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/>')
FWRITE(lhFile, '</Relationships>')
FCLOSE(lhFile)
*-* Save the app XML
lcFileName = tcPath + "docProps\app.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<Properties xmlns="http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" xmlns:vt="http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes">')
FWRITE(lhFile, '<Application>ExcelXMLX Release ' + TRANSFORM(this.ExcelXlsxRelease) + '</Application>')
IF !EMPTY(this.CompanyName)
FWRITE(lhFile, '<Company>' + this.CompanyName + '</Company>')
ENDIF
FWRITE(lhFile, '</Properties>')
FCLOSE(lhFile)
STRTOFILE(STRCONV(FILETOSTR(lcFileName), 9), lcFileName, 4) && Save as UTF-8
*-* Save the core XML
lcFileName = tcPath + "docProps\core.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>')
FWRITE(lhFile, '<cp:coreProperties ')
FWRITE(lhFile, 'xmlns:cp="http://schemas.openxmlformats.org/package/2006/metadata/core-properties" ')
FWRITE(lhFile, 'xmlns:dc="http://purl.org/dc/elements/1.1/" ')
FWRITE(lhFile, 'xmlns:dcterms="http://purl.org/dc/terms/" ')
FWRITE(lhFile, 'xmlns:dcmitype="http://purl.org/dc/dcmitype/" ')
FWRITE(lhFile, 'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">')
IF !EMPTY(this.Title)
FWRITE(lhFile, '<dc:title>' + this.GetXMLString(this.Title) + '</dc:title>')
ENDIF
IF !EMPTY(this.Subject)
FWRITE(lhFile, '<dc:subject>' + this.GetXMLString(this.Subject) + '</dc:subject>')
ENDIF
IF !EMPTY(this.CreatorName)
FWRITE(lhFile, '<dc:creator>' + this.GetXMLString(this.CreatorName) + '</dc:creator>')
ENDIF
IF !EMPTY(this.UserName)
FWRITE(lhFile, '<cp:lastModifiedBy>' + this.GetXMLString(this.UserName) + '</cp:lastModifiedBy>')
ENDIF
IF VERSION(5) < 900
FWRITE(lhFile, '<dcterms:created xsi:type="dcterms:W3CDTF">' + this.TTOC3(DATETIME()) + 'Z</dcterms:created>')
FWRITE(lhFile, '<dcterms:modified xsi:type="dcterms:W3CDTF">' + this.TTOC3(DATETIME()) + 'Z</dcterms:modified>')
ELSE
FWRITE(lhFile, '<dcterms:created xsi:type="dcterms:W3CDTF">' + TTOC(DATETIME(), 3) + 'Z</dcterms:created>')
FWRITE(lhFile, '<dcterms:modified xsi:type="dcterms:W3CDTF">' + TTOC(DATETIME(), 3) + 'Z</dcterms:modified>')
ENDIF
FWRITE(lhFile, '</cp:coreProperties>')
FCLOSE(lhFile)
STRTOFILE(STRCONV(FILETOSTR(lcFileName), 9), lcFileName, 4) && Save as UTF-8
llSuccess = True
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 18
RAISEEVENT(this, "OnShowErrorMessage", 18, "Unable to create workbook supporting XMLs")
ENDTRY
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE writeworkbookxml && Writes the workbook XML
LPARAMETERS tnWB, tcPath
LOCAL lcFileName, lhFile, loException, llSuccess, lcSheetName
RAISEEVENT(this, "OnShowStatusMessage", 2, 4)
TRY
lcFileName = tcPath + "xl\workbook.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'+ LF)
FWRITE(lhFile, '<workbook xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships">')
*-* Write thw sheet information
FWRITE(lhFile, '<sheets>')
SELECT xl_relationships
SET ORDER TO TAG relid
SCAN FOR workbook = tnWB .AND. reltype = "worksheet"
IF SEEK(BINTOC(tnWB)+BINTOC(xl_relationships.sheet), "xl_sheets", "sheetndx")
DO CASE
CASE xl_sheets.state = VISIBLE_SHEET_STATE
FWRITE(lhFile, '<sheet r:id="rId' + TRANSFORM(xl_relationships.relid) + '" sheetId="' + TRANSFORM(xl_relationships.sheet) + '" name="' + ALLTRIM(xl_sheets.shname) + '"/>')
CASE xl_sheets.state = HIDDEN_SHEET_STATE
FWRITE(lhFile, '<sheet r:id="rId' + TRANSFORM(xl_relationships.relid) + '" sheetId="' + TRANSFORM(xl_relationships.sheet) + '" state="hidden" name="' + ALLTRIM(xl_sheets.shname) + '"/>')
CASE xl_sheets.state = VERYHIDDEN_SHEET_STATE
FWRITE(lhFile, '<sheet r:id="rId' + TRANSFORM(xl_relationships.relid) + '" sheetId="' + TRANSFORM(xl_relationships.sheet) + '" state="veryHidden" name="' + ALLTRIM(xl_sheets.shname) + '"/>')
ENDCASE
ELSE
THROW
ENDIF
ENDSCAN
SET ORDER TO
FWRITE(lhFile, '</sheets>')
*-* Write the named range information
SELECT xl_namerange
LOCATE FOR workbook = tnWB .AND. !DELETED()
IF FOUND()
FWRITE(lhFile, '<definedNames>')
SCAN FOR workbook = tnWB .AND. !DELETED()
IF (xl_namerange.begcol = 0 .AND. xl_namerange.begrow = 0) .OR. (xl_namerange.begcol = 0 .AND. xl_namerange.begrow = 0)
LOOP
ENDIF
FWRITE(lhFile, '<definedName name="' + ALLTRIM(xl_namerange.rname) + '"')
IF !EMPTY(xl_namerange.comment)
FWRITE(lhFile, ' comment="' + ALLTRIM(xl_namerange.comment) + '"')
ENDIF
IF xl_namerange.scope = SCOPE_SH_NAMED_RANGE
FWRITE(lhFile, ' localSheetId="' + TRANSFORM(xl_namerange.sheet) + '"')
ENDIF
FWRITE(lhFile, '>')
lcSheetName = this.GetSheetName(tnWB, xl_namerange.sheet)
FWRITE(lhFile, IIF(OCCURS(" ", lcSheetName)>0, "'", "") + lcSheetName + IIF(OCCURS(" ", lcSheetName)>0, "'", ""))
DO CASE
CASE xl_namerange.begcol = 0 .AND. xl_namerange.begrow > 0
FWRITE(lhFile, '!$' + TRANSFORM(xl_namerange.begrow))
CASE xl_namerange.begcol > 0 .AND. xl_namerange.begrow = 0
FWRITE(lhFile, '!$' + this.ColumnIndexToAscii(xl_namerange.begcol))
OTHERWISE
FWRITE(lhFile, '!$' + this.ColumnIndexToAscii(xl_namerange.begcol) + '$' + TRANSFORM(xl_namerange.begrow))
ENDCASE
DO CASE
CASE xl_namerange.endcol = 0 .AND. xl_namerange.endrow > 0
FWRITE(lhFile, ':$' + TRANSFORM(xl_namerange.endrow))
CASE xl_namerange.endcol > 0 .AND. xl_namerange.begrow = 0
FWRITE(lhFile, ':$' + this.ColumnIndexToAscii(xl_namerange.endcol))
OTHERWISE
FWRITE(lhFile, ':$' + this.ColumnIndexToAscii(xl_namerange.endcol) + '$' + TRANSFORM(xl_namerange.endrow))
ENDCASE
FWRITE(lhFile, '</definedName>')
ENDSCAN
FWRITE(lhFile, '</definedNames>')
ENDIF
*-* Close the workbook
FWRITE(lhFile, '<calcPr calcId="0"/>')
FWRITE(lhFile, '</workbook>')
llSuccess = True
CATCH TO loException
FCLOSE(lhFile)
SET STEP ON
llSuccess = False
FINALLY
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
ENDTRY
RETURN llSuccess
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink