*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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"
*
*m: addautofilter && Adds a filter to the column range
*m: addclassdefinednumericformats && Adds pre-defined numeric cell formats
*m: addcolumnfilter && Sets the specific filter for a column
*m: addcustomdatetimeformat && Adds a new date or datetime format
*m: addcustomnumericformat && Adds a new custom defined numeric format
*m: addfilestozip && Adds the xml files for the xlsx file to a zip file
*m: addgroupbycolumn && Adds a data group level by columns
*m: addgroupbyrow && Adds a data group level by rows
*m: addhyperlinkfile && Adds a hyperlink to the sheet for an external file
*m: addhyperlinksheet && Adds a new hyperlink to the selected cell range with the target another cell range
*m: addimage && Adds an image to a sheet
*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: addstringtoheap && Adds the string to the heap for parsing
*m: addstringvalue && Adds a string value to the internal cursor
*m: addstyleborders && Adds to the cell style a border definition
*m: addstylecellformat && Adds the cell format Id to the format style (same as AddStyleNumericformat method)
*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: addstyleprotection && Adds the cell protection setting to the style
*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: at && Fast string replacement for AT() function
*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: checksheetname && Checks the sheet name for valid characters; returns a corrected string (invalid characters converted to underscore _)
*m: clearautofilter && Clears the column filter for the sheet
*m: clearcellvalidation && Clears/deletes the named range from the workbook
*m: clearcellvalue && Clears the cell value
*m: clearprintarea && Clears the selected sheet's print area
*m: columnasciitoindex && Converts Excel Ascii column value to index value
*m: columnindextoascii && Gets the column ASCII code for the column index
*m: convertcentimeterstoemu && Converts centimeters to English Metric Units for image placement
*m: convertcolortohex && Converts a color value (integer) to Hex representation
*m: convertfiletostring && Reads a file into a String value
*m: converthexstringtonumeric && ConvertHexStringToNumeric
*m: convertpixelstocentimeters && Converts pixels to Centimeters for image placement
*m: convertpixelstoexcelunits && Converts Pixel measurement to Excel measurement
*m: convertrangetocolumnrowvalues && Converts a given range format to the column and row values
*m: convertstringtofile && Converts a encoded string to file
*m: copystyle && Copies the selected style to a new style Id
*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: datetimeseparator_access
*m: debugmethod && Used for debugging only
*m: debug_assign
*m: declaredll && Declares the required support Win32 API
*m: deleteallworkbooks && Deletes all workbooks
*m: deletecell && Deletes the selected cell
*m: deletecolumn && Deletes the selected Column
*m: deletehyperlink && Deletes the selected hyperlink
*m: deleteimage && Deletes the image from the sheet
*m: deleterow && Deletes the selected row
*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: fastextract && Fast String Replacement for STREXTRACT() function
*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: 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: getcolumnhidden && Returns the column hidden setting
*m: getcolumnincolrowpair && Returns the column (Ascii value) in a ColRow pair; i.e., returns A from A6 reference
*m: getcolumnobject && Gets the column object definition
*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: getdisplaygridlines && Gets the display grid line setting for the sheet
*m: getdwgpicdefinition && Gets the image drawing settings
*m: getformatkeyexpr && Gets the key expression for t_format
*m: getgridcolumnformat && Gets the grid column format for the cell formatting
*m: getheaderfooterkeyexpr && Gets the key expression for the header footer table record
*m: getimagedimensions && Gets the image height and width dimensions
*m: getimagerelationshipid && Gets the image's relationship id
*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: getnamedrange && Gets the named range
*m: getnamedranges && Returns an object listing of all named ranges
*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: getprintarea && Gets the sheet print area settings
*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: getrelationtypetext && Gets the relation type text from the code
*m: getrgbvalues && Gets the specified RGB color value
*m: getrowheightkeyexpr && Gets the key expression for the c_rowheights
*m: getrowhidden && Gets the row hidden setting
*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: getrowmaxfontsize && Returns the max fontsize used in the row
*m: getsharedstringid && Gets the Shared Strings Id value for the cell text
*m: getsheetindex && Gets the sheet internal index from the sheet name
*m: getsheetname && Gets the sheet name
*m: getsheetprotection && Returns the sheet protection settings
*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: getstyleformatid && Gets the format style Id for the given numeric format, font format, and fill format
*m: gettargetfromrelationships && Gets the target (file name) for the relationship id from the passed relationships file
*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: getworkbookprotection && Gets the selected workbook protection
*m: getworkbooksheets && Returns the workbook sheets
*m: getxmlfirstsegment && Gets the first segment in a XML structure
*m: getxmlheaderfootertext && Returns a XML formatted string for the header and footer text
*m: getxmlnextsegment && Gets the next XML Segment in a XML structure
*m: getxmlsegment && Gets the selected XML Segment
*m: getxmlsegmentex && Returns the selected XML Segment
*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: isarray && Determines if the parameter passed is an array
*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: loaddrawingxml && Loads the drawing.xml into memory
*m: loadsheetxml && Loads the sheet.xml into memory variable
*m: loadstylesxml && Loads the styles.xml into memory
*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: openxlsxfileaszip && Opens the xlsx file and extracts the xml files to a temporary folder [override this method for an alternate way to extract the files to the folder]
*m: openxlsxworkbook && Opens the passed Xlsx workbook and loads the internal cursors with the content
*m: openxlsxworkbooksheet && Opens a selected worksheet in a XLXS workbook
*m: parsestring && Parses a string based on a specified delimiter
*m: readcellvalueformat && Reads the cell value and format for a sheet
*m: readcommentxml && Reads the comment definitions for the sheet
*m: readdrawingxml && Reads the drawing (image) xml for associated 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: releasestringfromheap && Releases the string from the heap memory
*m: removeworkingdirectories && Removes the working directories
*m: renamesheet && Renames the selected sheet
*m: resetcolumnwidth && Resets the column width to default
*m: restorevfpsettings && Restores the VFP system settings
*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: savevfpsettings && Saves the VFP system settings
*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: setcolumnhidden && Sets the column hidden setting
*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: setdisplaygridlines && Sets the sheet display grid lines setting
*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: setprintarea && Sets the print area for the 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: setrowhidden && Sets the row hidden setting
*m: setrowmaxcolumn && Sets the value for the maximum cell column in a row
*m: setsheetgroupsettings && Sets the group settings for a given sheet
*m: setsheetmargins && Sets the sheet margin values
*m: setsheetprintoptions && Sets the sheet print options
*m: setsheetprotection && Sets the sheet protection on or off
*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: settabcolor && Sets the sheet tab color
*m: setworkbookprotection && Sets the Workbook protection
*m: testcode && Method to test code for debugging
*m: ttoc3 && Equlivalent of TTOC() function for pre VFP9 support
*m: unfreezepanes && Removes the pane freeze from the sheet
*m: ungroupbycolumn && Removes a data group level by columns
*m: ungroupbyrow && Removes a data group level by rows
*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: writedrawingdefinitionxml && Writes the drawing definition XML
*m: writeimagerelationshipsxml && Writes the image relationship (.rels) xml file
*m: writesheetrelationshipsxml && Writes the sheet 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: autoheight && Boolean to indicate if the row heights are to be set by text font size of the largest fontsize in the row
*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: datetimeseparator && Separator for a DATETIME value
*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: defaultpw && Default password for protection; encoded vfpxworkbookxlsx
*p: defaultsheetname && Default sheet name (language specific)
*p: errorlevelid && Error level Id ***Integer
*p: excelxlsxrelease && Release version of Class ***Integer
*p: nullvalue && Value to be assigned for field .NULL. values
*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
*p: vfpsettings && VFP Settings set by core program; created as an object with properties in Init() event
*a: globalid[1,2] && Global Id value for images
*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: lastdrawingrelsid[1,2] && LastDrawingRelsId
*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: lastsheetid[1,2] && Last used sheet Id
*a: lastsheetrelsid[1,2] && LastSheetRelsId
*a: laststringid[1,2] && Stores the last used string Id for a workbook
*a: lastworkbookrelsid[1,2] && LastWorkbookRelsId
*a: stringndx[1,0] && Returns the next string index value by workbook ***Integer
*p: _memberdata && XML Metadata for customizable properties
*
PROTECTED destroy,init
*
autoheight = .F.
AutoSize = .T.
autotrimsheetname = .T.
Caption = "clsVFPxWorkbookXLSX"
codepage = 0
companyname = VFPxWorkbookXLSX
creatorname = VFPxWorkbookXLSX
datetimeseparator = /
debug = .F.
declarewinapi = .T.
defaultfont = Calibri
defaultfontsize = 11
defaultpw = F771
defaultsheetname = Sheet
errorlevelid = 0
excelxlsxrelease = 38
Height = 17
Name = "vfpxworkbookxlsx"
nullvalue = .NULL.
oxdom =
savecurrencyasnumeric = .F.
subject =
title =
truefalsevalue = Yes|No
username = VFPxWorkbookXLSX
vfpsettings =
Visible = .F.
Width = 129
_memberdata =
*
PROCEDURE AddAutoFilter && Adds a filter to the column range
LPARAMETERS tnWB, tnSheet, tnBegCol, tnEndCol
DO CASE
CASE PCOUNT() < 3
RETURN False
CASE PCOUNT() = 3
tnEndCol = tnBegCol
ENDCASE
IF tnBegCol > tnEndCol
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet), "xl_sheets", "sheet")
REPLACE xl_sheets.addfilter WITH True, ;
xl_sheets.filtbegcol WITH tnBegCol, ;
xl_sheets.filtendcol WITH tnEndCol IN xl_sheets
ELSE
RETURN False
ENDIF
RETURN True
ENDPROC
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 = '_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* "-"??_-;_-@_-'
lcTextFormat = '"£"#,##0.00;[Red]("£"#,##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 = '_-[$€-2]* .00_-;-[$€-2]* .00_-;_-[$€-2]* "-"??_-;_-@_-'
lcTextFormat = '"€"#,##0.00;[Red]("€"#,##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 = '[$£-809]#,##0.00;[Red]\-[$£-809]#,##0.00'
lcTextFormat = '"£"#,##0.00;[Red]("£"#,##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 = '[$€-2]\ #,##0.00_);[Red]\([$€-2]\ #,##0.00\)'
lcTextFormat = '"€"#,##0.00;[Red]("€"#,##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 AddColumnFilter && Sets the specific filter for a column
LPARAMETERS tnWB, tnSheet, tnCol, tcOperator, txFilterValue, tlAndOperator
DO CASE
CASE PCOUNT() < 5
RETURN False
CASE PCOUNT() = 5
tlAndOperator = False
ENDCASE
INSERT INTO xl_filters (workbook, sheet, col, filtoper, filtvalue, andoperator) ;
VALUES (tnWB, tnSheet, tnCol, tcOperator, TRANSFORM(txFilterValue), tlAndOperator)
REPLACE xl_filters.andoperator WITH tlAndOperator FOR workbook = tnWB AND sheet = tnSheet AND col = tnCol IN xl_filters
RETURN True
ENDPROC
PROCEDURE AddCustomDateTimeFormat && Adds a new date or datetime format
LPARAMETERS tnWB, tcDateFormat
LOCAL lcFormatCode, lnId
IF PCOUNT() < 2
RETURN 0
ENDIF
IF SEEK(BINTOC(tnWB)+PADR(tcDateFormat, 25, "X"), "xl_numFmts", "formatcode")
RETURN xl_numFmts.id
ELSE
lcFormatCode = STRTRAN(tcDateFormat, " ", "\ ")
IF ATC(CELL_FORMAT_LOCALE_CODE, lcFormatCode) = 0
lcFormatCode = CELL_FORMAT_LOCALE_CODE + lcFormatCode
ENDIF
lnId = this.GetNextId(tnWB, 0, "xl_numfmts")
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, lnId, this.GetXMLString(lcFormatCode), tcDateFormat, False)
RETURN lnId
ENDIF
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, 0, "xl_numfmts")
INSERT INTO xl_numFmts (workbook, id, formatxml, formatcode, applydec) ;
VALUES (tnWB, lnId, this.GetXMLString(lcFormatCode), lcFormatCode, tlApplyDec)
RETURN lnId
ENDPROC
PROTECTED PROCEDURE AddFilesToZip && Adds the xml files for the xlsx file to a zip file
LPARAMETERS tcTempPath, tcZipFile
LOCAL llReturn, loShell, loFolder, loFile, lnCountBefore, loException
TRY
STRTOFILE(CHR(80)+CHR(75)+CHR(5)+CHR(6)+REPLICATE(CHR(0), 18), tcZipFile, 0)
loShell = CREATEOBJECT("shell.application")
loFolder = loShell.NameSpace(tcTempPath).Items
IF VAL(VERSION(4)) <= 9 .AND. (VAL(OS(3))<6 .OR. VAL(OS(3))=6 .AND. VAL(OS(4))<1) && Fix for VFPA provided by Doug Hennig; VAL() fix provided by starfiresg1
FOR EACH loFile IN loFolder
loShell.NameSpace(tcZipFile).MoveHere(loFile, FOF_SILENT)
apiSleep(100)
ENDFOR
ELSE
FOR EACH loFile IN loFolder
lnCountBefore = loShell.NameSpace(tcTempPath).Items.Count
loShell.NameSpace(tcZipFile).MoveHere(loFile, FOF_SILENT)
DO WHILE lnCountBefore = loShell.NameSpace(tcTempPath).Items.Count
apiSleep(50)
ENDDO
ENDFOR
ENDIF
llReturn = True
CATCH TO loException
SET STEP ON
this.ErrorLevelId = 12
RAISEEVENT(this, "OnShowErrorMessage", 12, "CreateExcelFile - Failed to add contents to Zip file"+ CR + loException.Message)
ERASE (tcZipFile)
llReturn = False
ENDTRY
RETURN llReturn
ENDPROC
PROCEDURE AddGroupByColumn && Adds a data group level by columns
LPARAMETERS tnWB, tnSheet, tnBegCol, tnEndCol
LOCAL lnCol, lnLevel
LOCAL ARRAY laLevel[1]
IF PCOUNT() != 4 .OR. VARTYPE(tnBegCol) != "N" .OR. VARTYPE(tnEndCol) != "N"
RETURN False
ENDIF
SELECT MAX(collevel) FROM xl_columns WHERE BINTOC(workbook)+BINTOC(sheet) = BINTOC(tnWB)+BINTOC(tnSheet) .AND. col >= tnBegCol .AND. col <= tnEndCol INTO ARRAY laLevel
lnLevel = NVL(laLevel[1], 0) + 1
FOR lnCol=tnBegCol TO tnEndCol
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(lnCol), "xl_columns", "col")
REPLACE xl_columns.collevel WITH lnLevel IN xl_columns
ELSE
INSERT INTO xl_columns (workbook, sheet, col, width, collevel, collapsed) VALUES (tnWB, tnSheet, lnCol, -1.0, lnLevel, False)
ENDIF
ENDFOR
RETURN True
ENDPROC
PROCEDURE AddGroupByRow && Adds a data group level by rows
LPARAMETERS tnWB, tnSheet, tnBegRow, tnEndRow
LOCAL lnRow, lnLevel
LOCAL ARRAY laLevel[1]
IF PCOUNT() != 4 .OR. VARTYPE(tnBegRow) != "N" .OR. VARTYPE(tnEndRow) != "N"
RETURN False
ENDIF
SELECT MAX(rowlevel) FROM xl_rows WHERE BINTOC(workbook)+BINTOC(sheet) = BINTOC(tnWB)+BINTOC(tnSheet) .AND. row >= tnBegRow .AND. row <= tnEndRow INTO ARRAY laLevel
lnLevel = NVL(laLevel[1], 0) + 1
FOR lnRow=tnBegRow TO tnEndRow
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(lnRow), "xl_rows", "row")
REPLACE xl_rows.rowlevel WITH lnLevel IN xl_rows
ELSE
INSERT INTO xl_rows (workbook, sheet, row, height, rowlevel, collapsed, hidden) VALUES (tnWB, tnSheet, lnRow, -1.00, lnLevel, False, 0)
ENDIF
ENDFOR
RETURN True
ENDPROC
PROCEDURE AddHyperLinkFile && Adds a hyperlink to the sheet for an external file
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tcTarget
LOCAL ARRAY laFile[1]
IF PCOUNT() = 7 .AND. !SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnBegRow)+BINTOC(tnBegCol)+BINTOC(tnEndRow)+BINTOC(tnEndCol), "xl_hyperlinks", "hyperlink")
IF ADIR(laFile, tcTarget) > 0
lnRelId = this.GetNextId(tnWB, tnSheet, "xl_sheet_rels")
INSERT INTO xl_hyperlinks (workbook, sheet, begrow, begcol, endrow, endcol, targettype, relid) ;
VALUES (tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, HYPERLINK_TYPE_FILE, lnRelId)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, external) ;
VALUES (tnWB, tnSheet, RELS_SRC_SHEET, lnRelId, RELS_TYPE_HYPERLINK, tcTarget, True)
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
RETURN True
ENDPROC
PROCEDURE AddHyperLinkSheet && Adds a new hyperlink to the selected cell range with the target another cell range
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, tnTgtSheet, tnTgtBegRow, tnTgtBegCol, tnTgtEndRow, tnTgtEndCol, tcDisplay
IF PCOUNT() >= 11 .AND. !SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnBegRow)+BINTOC(tnBegCol)+BINTOC(tnEndRow)+BINTOC(tnEndCol), "xl_hyperlinks", "hyperlink")
IF PCOUNT() = 11 .OR. EMPTY(tcDisplay) .OR. VARTYPE(tcDisplay) != "C"
tcDisplay = TRANSFORM(this.GetCellValue(tnWB, tnSheet, tnBegRow, tnBegCol))
ENDIF
INSERT INTO xl_hyperlinks (workbook, sheet, begrow, begcol, endrow, endcol, targettype, tgtsheet, tgtbegrow, tgtbegcol, tgtendrow, tgtendcol, display, relid) ;
VALUES (tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol, HYPERLINK_TYPE_SHEET, tnTgtSheet, tnTgtBegRow, tnTgtBegCol, tnTgtEndRow, tnTgtEndCol, tcDisplay, 0)
ELSE
RETURN False
ENDIF
RETURN True
ENDPROC
PROCEDURE AddImage && Adds an image to a sheet
LPARAMETERS tnWB, tnSheet, tcImageFile, tcAnchorType, tcImgMove, tnBegCol, tnBegColOff, tnBegRow, tnBegRowOff, tnEndCol, tnEndColOff, tnEndRow, tnEndRowOff
LOCAL lnImgId, lnRelId, loDimens, lnGblId, lcFileExtn, lnCX, lnCY, lnImgWidth, lnImgHeight
LOCAL ARRAY laFile[1]
IF PCOUNT() < 3
RETURN 0
ENDIF
IF !PEMSTATUS(_SCREEN, "System", 5) .OR. VARTYPE(_SCREEN.System) <> "O"
RETURN 0
ENDIF
IF ADIR(laFile, tcImageFile) > 0
loDimens = this.GetImageDimensions(tcImageFile)
IF ISNULL(loDimens)
RETURN 0
ENDIF
lnCX = this.ConvertPixelsToCentimeters(loDimens.Width, "W")
lnCY = this.ConvertPixelsToCentimeters(loDimens.Height, "H")
IF VARTYPE(tcAnchorType) = "L"
tcAnchorType = IMAGE_ANCHOR_TYPE_ONE
ENDIF
IF VARTYPE(tcImgMove) = "L"
tcImgMove = ""
ENDIF
IF VARTYPE(tnBegCol) = "L"
tnBegCol = 1
ENDIF
IF VARTYPE(tnBegColOff) = "L"
tnBegColOff = 0
ENDIF
IF VARTYPE(tnBegRow) = "L"
tnBegRow = 1
ENDIF
IF VARTYPE(tnBegRowOff) = "L"
tnBegRowOff = 0
ENDIF
IF VARTYPE(tnEndCol) = "L"
tnEndCol = tnBegCol + 1
ENDIF
IF VARTYPE(tnEndColOff) = "L"
tnEndColOff = lnCX
ENDIF
IF VARTYPE(tnEndRow) = "L"
tnEndRow = tnBegRow + 1
ENDIF
IF VARTYPE(tnEndRowOff) = "L"
tnEndRowOff = lnCY
ENDIF
tcAnchorType = NVL(tcAnchorType, IMAGE_ANCHOR_TYPE_ONE)
tcImgMove = NVL(tcImgMove, "")
tnBegCol = NVL(tnBegCol, 1)
tnBegColOff = NVL(tnBegColOff, 0)
tnBegRow = NVL(tnBegRow, 1)
tnBegRowOff = NVL(tnBegRowOff, 0)
tnEndCol = NVL(tnEndCol, tnBegCol+1)
tnEndColOff = NVL(tnEndColOff, 0)
tnEndRow = NVL(tnEndRow, tnBegRow+1)
tnEndRowOff = NVL(tnEndRowOff, 0)
IF tcAnchorType = IMAGE_ANCHOR_TYPE_TWO .AND. EMPTY(tcImgMove)
tcImgMove = IMAGE_ANCHOR_MOVE_ONE
ENDIF
lnImgHeight = this.ConvertCentimetersToEMU(lnCX)
lnImgWidth = this.ConvertCentimetersToEMU(lnCY)
tnBegColOff = this.ConvertCentimetersToEMU(tnBegColOff)
tnBegRowOff = this.ConvertCentimetersToEMU(tnBegRowOff)
tnEndColOff = this.ConvertCentimetersToEMU(tnEndColOff)
tnEndRowOff = this.ConvertCentimetersToEMU(tnEndRowOff)
lnImgId = this.GetNextId(tnWB, tnSheet, "xl_drawing_rels")
lnGblId = this.GetNextId(tnWB, tnSheet, "global")
INSERT INTO xl_images (workbook, sheet, relid, anchor, imgmove, begcol, begcoloff, begrow, begrowoff, endcol, endcoloff, endrow, endrowoff, cx, cy) ;
VALUES (tnWB, tnSheet, lnImgId, tcAnchorType, tcImgMove, tnBegCol-1, tnBegColOff, tnBegRow-1, tnBegRowOff, tnEndCol-1, tnEndColOff, ;
tnEndRow-1, tnEndRowOff, lnImgHeight, lnImgWidth)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, external, globalid, filecontent) ;
VALUES (tnWB, tnSheet, RELS_SRC_DRAWING, lnImgId, RELS_TYPE_IMAGE, JUSTFNAME(tcImageFile), False, lnGblId, this.ConvertFileToString(tcImageFile, 13))
IF !SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+RELS_TYPE_DRAWING, "xl_relationships", "reltype")
lnRelId = this.GetNextId(tnWB, tnSheet, "xl_sheet_rels")
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, external) ;
VALUES (tnWB, tnSheet, RELS_SRC_SHEET, lnRelId, RELS_TYPE_DRAWING, "../drawings/drawing" + TRANSFORM(tnSheet) + ".xml", False)
ENDIF
lcFileExtn = LOWER(JUSTEXT(tcImageFile))
IF !SEEK(BINTOC(tnWB)+lcFileExtn, "xl_contenttypes", "extension")
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (tnWB, lcFileExtn, "image/" + lcFileExtn)
ENDIF
ELSE
RETURN 0
ENDIF
RETURN lnImgId
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, 0, "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, 0, "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("_", 26))
IF !ISALPHA(lcRangeName) .AND. !INLIST(LEFT(lcRangeName, 1), "_", "\")
lcRangeName = "_" + lcRangeName
ENDIF
IF INLIST(UPPER(lcRangeName), "_FILTERDATABASE", "CRITERIA", "EXTRACT", "PRINT_AREA", "PRINT_TITLE")
lcRangeName = "_xlnm." + lcRangeName
ENDIF
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
IF SEEK(BINTOC(tnWB)+PADL(lcRangeName, 50, " "), "xl_namerange", "wbrname")
UPDATE xl_namerange ;
SET begrow = tnBegRow, ;
begcol = tnBegCol, ;
endrow = tnEndRow, ;
endcol = tnEndCol ;
WHERE workbook = tnWB ;
AND sheet = tnSheet ;
AND rname = PADL(lcRangeName, 50, " ")
ELSE
INSERT INTO xl_namerange (workbook, sheet, rname, scope, comment, begrow, begcol, endrow, endcol) ;
VALUES (tnWB, tnSheet, lcRangeName, tnScope, tcComment, tnBegRow, tnBegCol, tnEndRow, tnEndCol)
ENDIF
ELSE
RETURN ""
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, 0, "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)
ELSE
tcSheetName = this.CheckSheetName(tcSheetName)
IF ISNULL(tcSheetName)
this.SetLastId(tnWB, 0, 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, autofilter, deletecol, deleterow, formatcell, formatcol, ;
formatrow, insertcol, insertrow, inserthyper, objects, pivottbl, scenarios, sellocked, selunlocked, sort, protection, gridlines) ;
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, ;
True, True, True, True, True, True, True, True, True, True, True, True, False, False, True, False, 1)
lnRelId = this.GetNextId(tnWB, 0, "xl_workbook_rels")
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (tnWB, lnShId, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_WORKSHEET, "worksheets/sheet" + TRANSFORM(lnShId) + ".xml")
ENDIF
ENDIF
RETURN lnShId
ENDPROC
PROTECTED PROCEDURE AddStringToHeap && Adds the string to the heap for parsing
LPARAMETERS tcString
LOCAL loString
loString = CREATEOBJECT("Empty")
ADDPROPERTY(loString, "BaseAdr", 0)
ADDPROPERTY(loString, "LastAdr", 0)
ADDPROPERTY(loString, "Length", LEN(tcString))
ADDPROPERTY(loString, "XMLDelimiter", "")
ADDPROPERTY(loString, "BegDelimiter", "")
ADDPROPERTY(loString, "EndDelimiter", "")
ADDPROPERTY(loString, "TextString", tcString)
loString.BaseAdr = apiHeapAlloc(apiGetProcessHeap(), 0, loString.Length)
SYS(2600, loString.BaseAdr, loString.Length, tcString)
RETURN loString
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, 0, "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, 0, "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, 0, '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, ;
xl_cellxfs.applyborder WITH 1 IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE AddStyleCellFormat && Adds the cell format Id to the format style (same as AddStyleNumericformat method)
LPARAMETERS tnWB, tnCellXfsId, tnNumFmtId
RETURN this.AddStyleNumericFormat(tnWB, tnCellXfsId, tnNumFmtId)
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, 0, 'xl_fills')
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed, fgtheme, bgtheme) ;
VALUES (tnWB, lnFillId, tnFColor, tnBColor, tcPatternType, 0, 0, lnFIndex, lnBIndex, -1, -1)
ENDIF
*-* Set the fill id to the style definition
REPLACE xl_cellxfs.fillid WITH lnFillId, ;
xl_cellxfs.applyfill WITH 1 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, 0, '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, ;
xl_cellxfs.applyfont WITH 1 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, ;
xl_cellxfs.applyalign WITH 1 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 = CELL_FORMAT_DATETIME_MDYYHMM
lcFormatCode = CHRTRAN("[$-409]m|d|yy h:mm", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_DDMMMYYYY_TTAM
lcFormatCode = CHRTRAN("[$-409]dd|mmm|yyyy h:mm AM/PM;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_DDMMMYYYY_TT24
lcFormatCode = CHRTRAN("[$-409]dd|mmm|yyyy h:mm;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MMMDDYYYY_TTAM
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, '[$-409]mmm d, yyyy h:mm AM/PM;@')
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MMMDDYYYY_TT24
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, '[$-409]mmm d, yyyy hh:mm;@')
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MDYY_TTAM
lcFormatCode = CHRTRAN("[$-409]m|d|yy h:mm AM/PM;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MDYY_TT24
lcFormatCode = CHRTRAN("[$-409]m|d|yy hh:mm;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
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 AddStyleProtection && Adds the cell protection setting to the style
LPARAMETERS tnWB, tnCellXfsId, tnLocked, tnHidden
IF PCOUNT() < 3
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnCellXfsId), "xl_cellxfs", "id")
IF VARTYPE(tnLocked) = 'N' .AND. BETWEEN(tnLocked, 0, 1) .AND. VARTYPE(tnHidden) = 'N' .AND. BETWEEN(tnHidden, 0, 1)
REPLACE xl_cellxfs.celllocked WITH tnLocked, ;
xl_cellxfs.cellhidden WITH tnHidden, ;
xl_cellxfs.applyprot WITH 1 IN xl_cellxfs
RETURN True
ELSE
RETURN False
ENDIF
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, ;
xl_cellxfs.applyalign WITH 1 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
PROTECTED PROCEDURE AT && Fast string replacement for AT() function
LPARAMETERS tcFindText, toString, tnOccurrence
LOCAL lnBeg, lcVal, lnLen, lnOccurrence
IF PCOUNT() = 2
tnOccurrence = 1
ENDIF
lnLen = LEN(tcFindText)
lnOccurrence = 0
lnBeg = 1
DO WHILE lnBeg < toString.Length
lcVal = SYS(2600, toString.BaseAdr-1 + lnBeg, lnLen)
IF lcVal == tcFindText
lnOccurrence = lnOccurrence + 1
IF lnOccurrence = tnOccurrence
RETURN lnBeg
ENDIF
ENDIF
lnBeg = lnBeg + 1
ENDDO
RETURN 0
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 CheckSheetName && Checks the sheet name for valid characters; returns a corrected string (invalid characters converted to underscore _)
LPARAMETERS tcSheetName
LOCAL lcSheetName
*-* Remove illegal characters from sheet name; replace with underscore character
lcSheetName = CHRTRAN(tcSheetName, ":\/[]?*", "_______")
*-* Check for characters converted to xml format that are invalid
lcSheetName = STRTRAN(lcSheetName, ":", "_") && : character
lcSheetName = STRTRAN(lcSheetName, "/", "_") && / character
lcSheetName = STRTRAN(lcSheetName, "\", "_") && \ character
lcSheetName = STRTRAN(lcSheetName, "?", "_") && ? character
lcSheetName = STRTRAN(lcSheetName, "*", "_") && * character
*-* Check for apostrophe (') at beginning or end (not allowed)
lcSheetName = ALLTRIM(lcSheetName, 1, "'")
*-* Verify max length of sheet name not exceeded
IF LEN(lcSheetName) > LIMITS_MAX_SH_NAME
IF this.AutoTrimSheetName
lcSheetName = LEFT(ALLTRIM(lcSheetName), LIMITS_MAX_SH_NAME)
ELSE
RETURN .NULL.
ENDIF
ENDIF
IF EMPTY(lcSheetName)
RETURN .NULL.
ENDIF
IF UPPER(lcSheetName) == "HISTORY"
RETURN .NULL.
ENDIF
lcSheetName = this.GetXMLString(lcSheetName)
IF EMPTY(lcSheetName)
RETURN .NULL.
ENDIF
RETURN lcSheetName
ENDPROC
PROCEDURE ClearAutoFilter && Clears the column filter for the sheet
LPARAMETERS tnWB, tnSheet
IF PCOUNT() != 2
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet), "xl_sheets", "sheet")
REPLACE xl_sheets.addfilter WITH False, ;
xl_sheets.filtbegcol WITH 0, ;
xl_sheets.filtendcol WITH 0 IN xl_sheets
ELSE
RETURN False
ENDIF
RETURN True
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 ClearPrintArea && Clears the selected sheet's print area
LPARAMETERS tnWB, tnSheet
IF PCOUNT() < 2
RETURN False
ENDIF
DELETE FROM xl_namerange ;
WHERE workbook = tnWB ;
AND sheet = tnSheet ;
AND rname = PADL("_xlnm.PRINT_AREA", 50, " ")
IF _TALLY > 0
RETURN True
ELSE
RETURN False
ENDIF
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 ConvertCentimetersToEMU && Converts centimeters to English Metric Units for image placement
LPARAMETERS tnCentimeter
RETURN tnCentimeter * 360000
ENDPROC
PROTECTED PROCEDURE ConvertColorToHex && Converts a color value (integer) to Hex representation
LPARAMETERS tnColor
LOCAL lnRed, lnGreen, lnBlue, lcHexRed, lcHexGreen, lcHexBlue
IF VARTYPE(tnColor) = "N"
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)
ELSE
RETURN ""
ENDIF
ENDPROC
PROTECTED PROCEDURE ConvertFileToString && Reads a file into a String value
LPARAMETERS tcFileName, tnConvSetting
RETURN STRCONV(FILETOSTR(tcFileName), tnConvSetting)
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 ConvertPixelsToCentimeters && Converts pixels to Centimeters for image placement
LPARAMETERS tnPixels, tcDirection
LOCAL lhDeviceHdl, lnPixelsPerInch
lhDeviceHdl = apiGetDC(0)
DO CASE
CASE tcDirection = "W" && Width
lnPixelsPerInch = apiGetDeviceCaps(lhDeviceHdl, 88) && LOGPIXELSX
CASE tcDirection = "H" && Height
lnPixelsPerInch = apiGetDeviceCaps(lhDeviceHdl, 90) && LOGPIXELSY
ENDCASE
lhDeviceHdl = apiReleaseDC(0,lhDeviceHdl)
RETURN tnPixels / lnPixelsPerInch * 2.54
ENDPROC
PROCEDURE ConvertPixelsToExcelUnits && Converts Pixel measurement to Excel measurement
LPARAMETERS tnPixels
RETURN tnPixels * 0.152542
ENDPROC
PROCEDURE ConvertRangeToColumnRowValues && Converts a given range format to the column and row values
LPARAMETERS tcCellRange
LOCAL loRange, lcBegRange, lcEndRange, lnNdx
loRange = createobject("Empty")
ADDPROPERTY(loRange, "BegCol", 0)
ADDPROPERTY(loRange, "BegRow", 0)
ADDPROPERTY(loRange, "EndCol", 0)
ADDPROPERTY(loRange, "EndRow", 0)
tcCellRange = CHRTRAN(tcCellRange, "$", "")
lcBegRange = GETWORDNUM(tcCellRange, 1, ":")
lcEndRange = GETWORDNUM(tcCellRange, 2, ":")
lnNdx = this.GetAlphaNumericSplit(lcBegRange)
DO CASE
CASE lnNdx = 0 && Column only range
loRange.BegCol = this.ColumnAsciiToIndex(lcBegRange)
loRange.BegRow = 0
CASE lnNdx = 1 && Row only range
loRange.BegCol = 0
loRange.BegRow = CAST(lcBegRange AS I)
OTHERWISE
loRange.BegCol = this.ColumnAsciiToIndex(LEFT(lcBegRange, lnNdx-1))
loRange.BegRow = CAST(SUBSTR(lcBegRange, lnNdx) AS I)
ENDCASE
lnNdx = this.GetAlphaNumericSplit(lcEndRange)
IF EMPTY(lcEndRange)
loRange.EndCol = 0
loRange.EndRow = 0
ELSE
DO CASE
CASE lnNdx = 0 && Column only range
loRange.EndCol = this.ColumnAsciiToIndex(lcEndRange)
loRange.EndRow = 0
CASE lnNdx = 1 && Row only range
loRange.EndCol = 0
loRange.EndRow = CAST(lcEndRange AS I)
OTHERWISE
loRange.EndCol = this.ColumnAsciiToIndex(LEFT(lcEndRange, lnNdx-1))
loRange.EndRow = CAST(SUBSTR(lcEndRange, lnNdx) AS I)
ENDCASE
ENDIF
RETURN loRange
ENDPROC
PROTECTED PROCEDURE ConvertStringToFile && Converts a encoded string to file
LPARAMETERS tcFileContent, tcFileName, tnConvSetting
IF PCOUNT() = 2
STRTOFILE(tcFileContent, tcFileName)
ELSE
STRTOFILE(STRCONV(tcFileContent, tnConvSetting), tcFileName)
ENDIF
ENDPROC
PROCEDURE CopyStyle && Copies the selected style to a new style Id
LPARAMETERS tnWB, tnCellXfsId
LOCAL lnId
IF PCOUNT() != 2
RETURN -1
ENDIF
SELECT * FROM xl_cellxfs WHERE BINTOC(workbook)+BINTOC(id) = BINTOC(tnWB)+BINTOC(tnCellXfsId) INTO CURSOR t_cellxfs
IF _TALLY > 0
lnId = this.GetNextId(tnWB, 0, "xl_cellxfs")
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, rotation, celllocked, cellhidden) ;
VALUES (tnWB, lnId, t_cellxfs.numFmtId, t_cellxfs.fontId, t_cellxfs.fillId, t_cellxfs.borderId, t_cellxfs.halign, t_cellxfs.valign, t_cellxfs.indent, ;
t_cellxfs.wraptext, t_cellxfs.rotation, t_cellxfs.celllocked, t_cellxfs.cellhidden)
ELSE
lnId = -1
ENDIF
USE IN SELECT('t_cellxfs')
RETURN lnId
ENDPROC
PROTECTED PROCEDURE CreateExcelFile && Creates the Excel file from the components
LPARAMETERS tcTempPath, tcFilePath, tcWBName, tlMacroEnabled
LOCAL lcZipFile, loException, lcZipPath, lhFile, llCreated, llError, lcTempZipFile
IF PCOUNT() = 3
tlMacroEnabled = False
ENDIF
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)
ERASE (lcZipFile)
CATCH TO loException
this.ErrorLevelId = 11
RAISEEVENT(this, "OnShowErrorMessage", 11, "CreateExcelFile - Failed to create Zip file"+ CR + loException.Message)
RETURN False
ENDTRY
*-* Add the files to the zip and rename to xlsx
lcTempZipFile = FORCEPATH(lcZipFile, SYS(2023)) && Use of temp file/directory provided by Doug Hennig to support share drives during zip creation process
llCreated = this.AddFilesToZip(tcTempPath, lcTempZipFile)
IF llCreated
TRY
IF tlMacroEnabled
apiMoveFile(lcTempZipFile, FORCEEXT(lcZipFile, "xlsm"))
ELSE
apiMoveFile(lcTempZipFile, FORCEEXT(lcZipFile, "xlsx"))
ENDIF
CATCH TO loException
llCreated = False
this.ErrorLevelId = 13
RAISEEVENT(this, "OnShowErrorMessage", 13, "CreateExcelFile - Rename failed"+ CR + loException.Message)
SET STEP ON
ENDTRY
ENDIF
RETURN llCreated
ENDPROC
PROCEDURE CreateFormatStyle && Creates a new format style definition
LPARAMETERS tnWB
LOCAL lnRelId, lnId
IF PCOUNT() > 0 .AND. SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
lnId = this.GetNextId(tnWB, 0, "xl_cellxfs")
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, rotation, celllocked, cellhidden) ;
VALUES (tnWB, lnId, 0, 0, 0, 0, "", "", 0, 0, 0, 1, 0)
*-* Check if the styles.xml has been defined for the workbook; if not, create the base style.xml definition
IF !SEEK(BINTOC(tnWB)+BINTOC(0)+RELS_TYPE_STYLES, "xl_relationships", "reltype")
lnRelId = this.GetNextId(tnWB, 0, "xl_workbook_rels")
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) VALUES (tnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_STYLES, "styles.xml")
this.SetDefaultFont(tnWB, this.DefaultFont, this.DefaultFontSize)
this.SetDefaultBorder(tnWB, BORDER_STYLE_NONE)
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, celllocked, cellhidden) ;
VALUES (tnWB, 0, 0, 0, 0, 0, "", "", 0, 0, 1, 0)
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed, fgtheme, bgtheme) ;
VALUES (tnWB, 0, 0, 0, FILL_STYLE_NONE, 0, 0, 0, 0, -1, -1)
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed, fgtheme, bgtheme) ;
VALUES (tnWB, 1, 0, 0, FILL_STYLE_GRAY125, 0, 0, 0, 0, -1, -1)
ENDIF
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, macroenabled) VALUES (lcWBName, lcPath, PADR(UPPER(tcName), 240, "_"), False)
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, sheet, relsrc, relid, reltype, target) VALUES (lnWB, 0, RELS_SRC_WORKBOOK, 1, RELS_TYPE_STYLES, "styles.xml")
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) VALUES (lnWB, 0, RELS_SRC_WORKBOOK, 2, RELS_TYPE_SHAREDSTRINGS, "sharedStrings.xml")
this.SetLastId(lnWB, 0, 2, "xl_workbook_rels")
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, celllocked, cellhidden) ;
VALUES (lnWB, 0, 0, 0, 0, 0, "", "", 0, 0, 1, 0)
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed, fgtheme, bgtheme) ;
VALUES (lnWB, 0, 0, 0, FILL_STYLE_NONE, 0, 0, 0, 0, -1, -1)
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed, fgtheme, bgtheme) ;
VALUES (lnWB, 1, 0, 0, FILL_STYLE_GRAY125, 0, 0, 0, 0, -1, -1)
INSERT INTO xl_contenttypes (workbook, extension, contenttype) ;
VALUES (lnWB, "rels", "application/vnd.openxmlformats-package.relationships+xml")
INSERT INTO xl_contenttypes (workbook, extension, contenttype) ;
VALUES (lnWB, "xml", "application/xml")
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, macroenabled) VALUES (lcWBName, lcPath, PADR(UPPER(tcName), 240, "_"), False)
lnWB = xl_workbooks.workbook
ENDIF
RETURN lnWB
ENDPROC
PROTECTED PROCEDURE CreateWorkingCursors && Creates the working cursors for worksheet definitions
LOCAL lcCollate, lcAlias
IF USED('xl_strings')
RETURN
ENDIF
lcAlias = ALIAS()
lcCollate = SET('COLLATE')
SET COLLATE TO 'MACHINE'
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)
CREATE CURSOR xl_cells CODEPAGE = 620 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 737 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 852 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 857 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 861 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 865 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 866 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 874 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 895 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 932 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 939 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 949 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 950 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 1250 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 1251 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 1252 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 1253 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 1255 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 1255 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
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)
CREATE CURSOR xl_cells CODEPAGE = 1256 (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
OTHERWISE
CREATE CURSOR xl_strings (id I, workbook I, checksum C(230), stringxml M, stringval M, presvspace L, formatted L)
CREATE CURSOR xl_cells (workbook I, sheet I, cellrow I, cellcol I, cellvalue M, datatype C(1), formulatype C(10), formulasi I, ;
stringid I, cellxfs I, numdec I, celldeleted L, validndx I)
ENDCASE
SELECT xl_strings
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
SET INDEX TO
SELECT xl_cells
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
SET INDEX TO
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()
SET INDEX TO
CREATE CURSOR xl_workbooks (workbook I AUTOINC NEXTVALUE 1, wbname C(200), filepath C(200), fullname C(240), protection L, password C(50), algorithm C(10), macroenabled L)
INDEX ON BINTOC(workbook) TAG workbook
INDEX ON UPPER(fullname) TAG fullname
INDEX ON PADR(UPPER(ALLTRIM(wbname)), 200, "_") TAG wbname
SET INDEX TO
CREATE CURSOR xl_sheets (workbook I, sheet I, shname C(30), state I, gridlines 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), outline L, grpsumbelow I, grpsumright I, protection L, password C(50), algorithm C(10), autofilter L, deletecol L, ;
deleterow L, formatcell L, formatcol L, formatrow L, insertcol L, insertrow L, inserthyper L, objects L, pivottbl L, scenarios L, sellocked L, selunlocked L, ;
sort L, addfilter L, filtbegcol I, filtendcol I, zoomscale I, prnopthead I, prnoptgrid I, draft I, blackwhite I, pagescale I, fittopage I, toplfcell C(20), ;
tabselctd I, activcell C(20), prnoptctrv I, prnoptctrh I)
INDEX ON workbook TAG workbook
INDEX ON BINTOC(workbook)+UPPER(ALLTRIM(shname)) TAG shname
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheet FOR !DELETED()
SET INDEX TO
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, ;
celllocked I, cellhidden I, applyfont I, applyborder I, applyalign I, applyprot I, applyfill 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) TAG gridstyle 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()
INDEX ON BINTOC(workbook)+BINTOC(fontId)+BINTOC(fillId)+BINTOC(borderId)+BINTOC(indent)+BINTOC(wraptext)+BINTOC(rotation)+BINTOC(celllocked)+BINTOC(cellhidden)+ALLTRIM(halign)+ALLTRIM(valign) TAG cellprot FOR !DELETED()
SET INDEX TO
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()
SET INDEX TO
CREATE CURSOR xl_fills (workbook I, id I, patttype C(25), theme I, tint F(20,15), fgcolor I, bgcolor I, fgindexed I, bgindexed I, fgtheme I, bgtheme 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()
SET INDEX TO
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()
SET INDEX TO
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()
SET INDEX TO
CREATE CURSOR xl_columns (workbook I, sheet I, col I, width N(16,9), bestfit L, collevel I, collapsed L, hidden I)
INDEX ON sheet TAG sheet
INDEX ON workbook TAG workbook
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(col) TAG col
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(col) TAG reverse DESCENDING
SET INDEX TO
CREATE CURSOR xl_filters (workbook I, sheet I, col I, andoperator L, filtoper C(20), filtvalue C(100))
INDEX ON sheet TAG sheet
INDEX ON workbook TAG workbook
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG colfilter
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(col) TAG col
SET INDEX TO
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()
SET INDEX TO
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()
SET INDEX TO
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()
SET INDEX TO
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()
SET INDEX TO
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()
INDEX ON BINTOC(workbook)+PADR(formatcode, 25, "X") TAG formatcode FOR !DELETED()
SET INDEX TO
CREATE CURSOR xl_rows (workbook I, sheet I, row I, maxcol I, height N(14,7), rowlevel I, collapsed L, hidden I)
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(row) TAG row FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(row) TAG reverse DESCENDING
SET INDEX TO
CREATE CURSOR xl_contenttypes (workbook I, extension C(5), contenttype C(60))
INDEX ON BINTOC(workbook) TAG workbook FOR !DELETED()
INDEX ON BINTOC(workbook)+extension TAG extension FOR !DELETED()
SET INDEX TO
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()
SET INDEX TO
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()
SET INDEX TO
CREATE CURSOR xl_relationships (workbook I, sheet I, relsrc C(1), relid I, reltype C(1), reltypeunk C(200), target C(200), filecontent M, relscontent M, external L, globalid I)
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheet FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+relsrc TAG relsrc FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+relsrc+reltype TAG relsrctype FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+reltype TAG reltype FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(relid) TAG relid FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(relid)+relsrc TAG relidsrc FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(relid)+reltype TAG relidtype FOR !DELETED()
SET INDEX TO
CREATE CURSOR xl_images (workbook I, sheet I, relid I, anchor C(1), imgmove C(8), begcol I, begcoloff I, begrow I, begrowoff I, ;
endcol I, endcoloff I, endrow I, endrowoff I, cx I, cy I)
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheet FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(relid) TAG relid FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(begrow)+BINTOC(begcol)+BINTOC(endrow)+BINTOC(endcol) TAG position FOR !DELETED()
SET INDEX TO
CREATE CURSOR xl_shapes (workbook I, sheet I, id I, imgmove C(8), begcol I, begcoloff I, begrow I, begrowoff I, endcol I, endcoloff I, endrow I, endrowoff I, ;
x I, cx I, y I, cy I, shpname C(25), descrptn C(25), prstgeom C(30), shpfill L)
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheet FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(id) TAG id FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(begrow)+BINTOC(begcol)+BINTOC(endrow)+BINTOC(endcol) TAG position FOR !DELETED()
SET INDEX TO
CREATE CURSOR xl_shptext (workbook I, sheet I, id I, shptext M, anchor C(8), insetb I, insett I, insetl I, insetr I, wraptext L, vertovrflo C(8), horzovrflo C(8), ;
rotation I, fontname C(25), fontsize I, fontbold L, fontitalic L, fontuline C(1))
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheet FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(id) TAG id FOR !DELETED()
SET INDEX TO
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()
SET INDEX TO
CREATE CURSOR xl_hyperlinks (workbook I, sheet I, begrow I, begcol I, endrow I, endcol I, targettype C(1), tgtsheet I, tgtbegrow I, tgtbegcol I, tgtendrow I, tgtendcol I, ;
location M, display C(200), relid I, tgtsheetname C(30))
INDEX ON BINTOC(workbook)+BINTOC(sheet) TAG sheet FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(relid) TAG relid FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(begrow)+BINTOC(begcol)+BINTOC(endrow)+BINTOC(endcol) TAG hyperlink FOR !DELETED()
SET INDEX TO
CREATE CURSOR xl_formulas (workbook I, sheet I, cellrow I, cellcol I, formulatype C(10), si I, ref M, formrel C(1), cellformula M, parsed M)
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(cellrow)+BINTOC(cellcol) TAG cell FOR !DELETED()
INDEX ON BINTOC(workbook)+BINTOC(sheet)+BINTOC(si) TAG si FOR !EMPTY(cellformula) .AND. !DELETED()
SET INDEX TO
SET COLLATE TO lcCollate
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
ENDPROC
PROTECTED PROCEDURE CreateWorkingDirectories && Creates the working directories for the XML files
LOCAL lcDir, loException, lnCnt
lnCnt = 0
TRY
*-* Get a unique directory name that is not used [suggestion by Doug Hennig]
lcDir = ADDBS(ADDBS(SYS(2023)) + SYS(2015))
DO WHILE DIRECTORY(lcDir)
INKEY(0.1, 'H')
lcDir = ADDBS(ADDBS(SYS(2023)) + SYS(2015))
lnCnt = lnCnt + 1
IF lnCnt > 20
THROW "Not able to create a unique directory name in CreateWorkingDirectories() method"
ENDIF
ENDDO
*-* Build the directory structure for the workbook files
MKDIR (lcDir)
MKDIR (lcDir + "_rels")
MKDIR (lcDir + "docProps")
MKDIR (lcDir + "xl")
MKDIR (lcDir + "xl\_rels")
MKDIR (lcDir + "xl\drawings")
MKDIR (lcDir + "xl\drawings\_rels")
MKDIR (lcDir + "xl\externalLinks")
MKDIR (lcDir + "xl\externalLinks\_rels")
MKDIR (lcDir + "xl\media")
MKDIR (lcDir + "xl\printerSettings")
MKDIR (lcDir + "xl\theme")
MKDIR (lcDir + "xl\worksheets")
MKDIR (lcDir + "xl\worksheets\_rels")
CATCH TO loException
lcDir = .NULL.
RAISEEVENT(this, "OnShowErrorMessage", 2, loException.Message)
ENDTRY
IF ISNULL(lcDir) && Correction identified by Doug Hennig
RETURN lcDir
ELSE
RETURN ADDBS(lcDir)
ENDIF
ENDPROC
PROCEDURE datetimeseparator_access
RETURN ALLTRIM(this.DateTimeSeparator, 1, '"', "'", '[', ']')
ENDPROC
PROCEDURE DebugMethod && Used for debugging only
LOCAL lcShFile, lcSheet, loSheet
lcShFile = GETFILE()
IF !EMPTY(lcShFile)
lcSheet = FILETOSTR(lcShFile)
loSheet = this.LoadSheetXml(lcSheet)
SET STEP ON
ENDIF
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 INTEGER ShellExecute IN Shell32 AS apiShellExecute LONG nhWnd, STRING lpAction, STRING lpFile, STRING lpParams, STRING lpDirectory, INTEGER nShowCmd
DECLARE INTEGER GetDeviceCaps IN GDI32 AS apiGetDeviceCaps LONG hDC, INTEGER nIndex
DECLARE INTEGER ReleaseDC IN User32 AS apiReleaseDC LONG nhWnd, LONG hDC
DECLARE INTEGER HeapAlloc IN Win32Api AS apiHeapAlloc INTEGER, INTEGER, INTEGER
DECLARE INTEGER HeapFree IN Win32APi AS apiHeapFree INTEGER, INTEGER, INTEGER
DECLARE LONG GetProcessHeap IN Win32API AS apiGetProcessHeap
DECLARE LONG MoveFile IN Win32API AS apiMoveFile STRING SourceFileName, STRING DestFileName
DECLARE LONG GetDC IN User32 AS apiGetDC LONG nhWnd
ENDPROC
PROCEDURE DeleteAllWorkbooks && Deletes all workbooks
LOCAL loException
TRY
this.DestroyWorkingCursors()
this.CreateWorkingCursors()
this.InitalizeIdValues()
CATCH TO loException
SET STEP ON
ENDTRY
ENDPROC
PROCEDURE DeleteCell && Deletes the selected cell
LPARAMETERS tnWB, tnSh, tnRow, tnCol, tnShift
DO CASE
CASE PCOUNT() < 4
RETURN False
CASE PCOUNT() = 4
tnShift = SHIFT_CELLS_LEFT
CASE VARTYPE(tnShift) != "N" .OR. !INLIST(tnShift, SHIFT_CELLS_LEFT, SHIFT_CELLS_UP)
tnShift = SHIFT_CELLS_LEFT
ENDCASE
DELETE FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSh .AND. xl_cells.cellrow = tnRow .AND. xl_cells.cellcol = tnCol IN xl_cells
DO CASE
CASE tnShift = SHIFT_CELLS_LEFT
REPLACE xl_cells.cellcol WITH xl_cells.cellcol - 1 FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSh .AND. xl_cells.cellrow = tnRow .AND. xl_cells.cellcol > tnCol IN xl_cells
CASE tnShift = SHIFT_CELLS_UP
REPLACE xl_cells.cellrow WITH xl_cells.cellrow - 1 FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSh .AND. xl_cells.cellcol = tnCol .AND. xl_cells.cellrow > tnRow IN xl_cells
OTHERWISE
RETURN False
ENDCASE
RETURN True
ENDPROC
PROCEDURE DeleteColumn && Deletes the selected Column
LPARAMETERS tnWB, tnSheet, tnCol
DELETE FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSh .AND. xl_cells.cellcol = tnCol IN xl_cells
REPLACE xl_cells.cellcol WITH xl_cells.cellcol - 1 FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSh .AND. xl_cells.cellcol > tnCol IN xl_cells
DELETE FOR xl_columns.workbook = tnWB .AND. xl_columns.sheet = tnSh .AND. xl_columns.col = tnCol IN xl_columns
REPLACE xl_columns.col WITH xl_columns.col - 1 FOR xl_columns.workbook = tnWB .AND. xl_columns.sheet = tnSh .AND. xl_columns.col > tnCol IN xl_columns
RETURN True
ENDPROC
PROCEDURE DeleteHyperLink && Deletes the selected hyperlink
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol
IF PCOUNT() = 6
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnBegRow)+BINTOC(tnBegCol)+BINTOC(tnEndRow)+BINTOC(tnEndCol), "xl_hyperlinks", "hyperlink")
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(xl_hyperlinks.relid)+RELS_TYPE_HYPERLINK, "xl_relationships", "relidtype")
DELETE IN xl_relationships
ENDIF
DELETE IN xl_hyperlinks
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
RETURN True
ENDPROC
PROCEDURE DeleteImage && Deletes the image from the sheet
LPARAMETERS tnWB, tnSheet, tnRelId
IF PCOUNT() = 3
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnRelId), "xl_images", "relid") ;
.AND. SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnRelId)+RELS_TYPE_IMAGE, "xl_relationships", "relidtype")
DELETE IN xl_relationships
DELETE IN xl_images
ELSE
RETURN False
ENDIF
ELSE
RETURN False
ENDIF
RETURN True
ENDPROC
PROCEDURE DeleteRow && Deletes the selected row
LPARAMETERS tnWB, tnSh, tnRow
DELETE FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSh .AND. xl_cells.cellrow = tnRow IN xl_cells
REPLACE xl_cells.cellrow WITH xl_cells.cellrow - 1 FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSh .AND. xl_cells.cellrow > tnRow IN xl_cells
DELETE FOR xl_rows.workbook = tnWB .AND. xl_rows.sheet = tnSh .AND. xl_rows.row = tnRow IN xl_rows
REPLACE xl_rows.row WITH xl_rows.row - 1 FOR xl_rows.workbook = tnWB .AND. xl_rows.sheet = tnSh .AND. xl_rows.row > tnRow IN xl_rows
RETURN True
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", "sheet") .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_columns
DELETE FOR workbook = tnWB IN xl_hdrfooterdefn
DELETE FOR workbook = tnWB IN xl_hdrfootertext
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.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 lnSh7, lnSh5, loInline, lnStyle1, lnStyle2, lnBorders, lcString, loProtection, lnCellXfsId, lnStyle3
LOCAL lnStyle4, lnStyle
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)
*-* Add values to cells
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
*-* Add data grouping by rows
this.AddGroupByRow(lnWb, lnSh1, 4, 8)
*-* Set row height
*this.SetRowHeight(lnWb, lnSh1, 6, 25)
this.AutoHeight = True
*-* 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 - DEPRECATED 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")
* 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)
*-* Add another data grouping by rows (level 2)
this.AddGroupByRow(lnWb, lnSh1, 6, 8)
*Column inserted
this.InsertColumn(lnWb, lnSh1, 5, INSERT_RIGHT)
* Cell insert
this.InsertCell(lnWb, lnSh1, 9, 9, INSERT_RIGHT)
this.InsertCell(lnWb, lnSh1, 11, 9, INSERT_BEFORE)
* Sheet setup examples
this.SetPrintOrientation(lnWb, lnSh1, PORTRAIT_PRINT_ORIENTATION)
this.SetPaperSize(lnWb, lnSh1, PAPERSIZE_LEGAL)
this.SetSheetScale(lnWb, lnSh1, 50)
* Image example (1st))
lcImageFile = ADDBS(SYS(5) + SYS(2003)) + "vfpxbanner.gif" && Must provide full path
this.AddImage(lnWb, lnSh1, lcImageFile, IMAGE_ANCHOR_TYPE_ONE,, 3, 0, 30, 0) && Positioned C30 cell
*******************************************************************************
lnSh2 = this.AddSheet(lnWb, "Test Sheet 2")
IF lnSh2 = 0
RETURN False
ENDIF
this.FreezePanes(lnWb, lnSh2, 1)
*-* Add column filtering
this.AddAutoFilter(lnWb, lnSh2, 2, 5)
this.AddColumnFilter(lnWb, lnSh2, 4, FILTER_OP_GREATERTHAN, 16, True)
this.AddColumnFilter(lnWb, lnSh2, 4, FILTER_OP_LESSTHAN, 24, True)
this.SetTabColor(lnWb, lnSh2, RGB(51,102,255))
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
this.SetRowHidden(lnWb, lnSh2, 13, True)
this.SetRowHidden(lnWb, lnSh2, 14, True)
* 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 -->")
*-* Test to over-write an existing formula with a cell value
*this.SetCellValue(lnWb, lnSh2, 16, 5, "This value overwrote formula value")
* 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 &P of &N", "Arial", 16, HEADERFOOTER_FONT_STYLE_BOLD)
* Hyperlink example - set in Sheet 1 (must have sheet 2 created first)
this.SetCellValue(lnWb, lnSh1, 26, 1, "Hyperlink Example 1 (Sheet)")
this.AddHyperLinkSheet(lnWb, lnSh1, 26, 1, 26, 1, lnSh2, 1, 1, 1, 3) && Sets the display value as the cell value by default
this.SetCellValue(lnWb, lnSh1, 27, 1, "Hyperlink Example 2 (External file)")
this.AddHyperLinkFile(lnWb, lnSh1, 27, 1, 27, 1, "..\vfpxworkbookxlsx.vcx") && The target file must exist; give path to file (can be relative)
*******************************************************************************
lnSh3 = this.AddSheet(lnWb, "Cell Formats")
IF lnSh3 = 0
RETURN False
ENDIF
this.DateTimeSeparator = "-" && Change this value to set the separator for date-time values; default value is /
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, 30)
this.SetColumnWidth(lnWb, lnSh3, 2, 110)
this.SetColumnWidth(lnWb, lnSh3, 3, 30)
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_INTEGER)
this.SetCellValue(lnWb, lnSh3, 3, 1, 16898)
this.SetCellStyle(lnWb, lnSh3, 3, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 3, 2, "CELL_FORMAT_INTEGER - Integer format")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_COMMA_INTEGER)
this.SetCellValue(lnWb, lnSh3, 4, 1, 16898)
this.SetCellStyle(lnWb, lnSh3, 4, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 4, 2, "CELL_FORMAT_COMMA_INTEGER - Integer format, comma separated")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_FLOAT)
this.SetCellValue(lnWb, lnSh3, 5, 1, 13355.2)
this.SetCellStyle(lnWb, lnSh3, 5, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 5, 2, "CELL_FORMAT_FLOAT - Float format")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_COMMA_FLOAT)
this.SetCellValue(lnWb, lnSh3, 6, 1, 13355.2)
this.SetCellStyle(lnWb, lnSh3, 6, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 6, 2, "CELL_FORMAT_COMMA_FLOAT - Float format, comma separated")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_CURRENCY_PAREN)
this.SetCellValue(lnWb, lnSh3, 7, 1, -13355.2)
this.SetCellStyle(lnWb, lnSh3, 7, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 7, 2, "CELL_FORMAT_CURRENCY_PAREN - Currency format, negative in parenthesis")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_CURRENCY_RED_PAREN)
this.SetCellValue(lnWb, lnSh3, 8, 1, -13355.2)
this.SetCellStyle(lnWb, lnSh3, 8, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 8, 2, "CELL_FORMAT_CURRENCY_RED_PAREN - Currency format, negative red in parenthesis")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_PERCENT_INTEGER)
this.SetCellValue(lnWb, lnSh3, 10, 1, 0.55)
this.SetCellStyle(lnWb, lnSh3, 10, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 10, 2, "CELL_FORMAT_PERCENT_INTEGER - Percent format, integer")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_PERCENT_FLOAT)
this.SetCellValue(lnWb, lnSh3, 11, 1, 0.5534)
this.SetCellStyle(lnWb, lnSh3, 11, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 11, 2, "CELL_FORMAT_PERCENT_FLOAT - Percent format, float")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_EXPONENT)
this.SetCellValue(lnWb, lnSh3, 13, 1, 456800000.00)
this.SetCellStyle(lnWb, lnSh3, 13, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 13, 2, "CELL_FORMAT_EXPONENT - Exponential format")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_FRACTION_1)
this.SetCellValue(lnWb, lnSh3, 15, 1, 0.25)
this.SetCellStyle(lnWb, lnSh3, 15, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 15, 2, "CELL_FORMAT_FRACTION_1 - Fraction format, single place")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_FRACTION_2)
this.SetCellValue(lnWb, lnSh3, 16, 1, 0.3125)
this.SetCellStyle(lnWb, lnSh3, 16, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 16, 2, "CELL_FORMAT_FRACTION_2 - Fraction format, 2 places")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATE_DMMMYY)
this.SetCellValue(lnWb, lnSh3, 18, 1, DATE())
this.SetCellStyle(lnWb, lnSh3, 18, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 18, 2, "CELL_FORMAT_DATE_DMMMYY - Default date format")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATE_DMMMYY)
this.SetCellValue(lnWb, lnSh3, 19, 1, DATE())
this.SetCellStyle(lnWb, lnSh3, 19, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 19, 2, "CELL_FORMAT_DATE_DMMMYY - Date format, d-mmm-yy")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATE_DMMM)
this.SetCellValue(lnWb, lnSh3, 20, 1, DATE())
this.SetCellStyle(lnWb, lnSh3, 20, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 20, 2, "CELL_FORMAT_DATE_DMMM - Date format, d-mmm")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATE_MMMYY)
this.SetCellValue(lnWb, lnSh3, 21, 1, DATE())
this.SetCellStyle(lnWb, lnSh3, 21, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 21, 2, "CELL_FORMAT_DATE_MMMYY - Date format, mmm-yy")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_TIME_HMMAMPM)
this.SetCellValue(lnWb, lnSh3, 23, 1, 0.35733796296296294)
this.SetCellStyle(lnWb, lnSh3, 23, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 23, 2, "CELL_FORMAT_TIME_HMMAMPM - Time format, h:mm AM/PM")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_TIME_HMMSSAMPM)
this.SetCellValue(lnWb, lnSh3, 24, 1, 0.35733796296296294)
this.SetCellStyle(lnWb, lnSh3, 24, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 24, 2, "CELL_FORMAT_TIME_HMMSSAMPM - Time format, h:mm:ss AM/PM")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_TIME_HMM)
this.SetCellValue(lnWb, lnSh3, 25, 1, 0.35733796296296294)
this.SetCellStyle(lnWb, lnSh3, 25, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 25, 2, "CELL_FORMAT_TIME_HMM - Time format, h:mm")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_TIME_HMMSS)
this.SetCellValue(lnWb, lnSh3, 26, 1, 0.35733796296296294)
this.SetCellStyle(lnWb, lnSh3, 26, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 26, 2, "CELL_FORMAT_TIME_HMMSS - Time format, h:mm:ss")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATETIME_MDYYHMM)
this.SetCellValue(lnWb, lnSh3, 28, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 28, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 28, 2, "CELL_FORMAT_DATETIME_MDYYHMM - Date-Time format, m/d/yy h:mm")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATETIME_DDMMMYYYY_TTAM)
this.SetCellValue(lnWb, lnSh3, 29, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 29, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 29, 2, "CELL_FORMAT_DATETIME_DDMMMYYYY_TTAM - Date-Time format, [$-409]dd/mmm/yyyy\ h:mm\ AM/PM;@")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATETIME_DDMMMYYYY_TT24)
this.SetCellValue(lnWb, lnSh3, 30, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 30, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 30, 2, "CELL_FORMAT_DATETIME_DDMMMYYYY_TT24 - Date-Time format, dd/mmm/yyyy\ h:mm;@")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATETIME_MMMDDYYYY_TTAM)
this.SetCellValue(lnWb, lnSh3, 31, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 31, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 31, 2, "CELL_FORMAT_DATETIME_MMMDDYYYY_TTAM - Date-Time format, [$-409]mmm\ d\,\ yyyy\ h:mm\ AM/PM;@")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATETIME_MMMDDYYYY_TT24)
this.SetCellValue(lnWb, lnSh3, 32, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 32, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 32, 2, "CELL_FORMAT_DATETIME_MMMDDYYYY_TT24 - Date-Time format, [$-409]mmm\ d\,\ yyyy\ h:mm;@")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATETIME_MDYY_TTAM)
this.SetCellValue(lnWb, lnSh3, 33, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 33, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 33, 2, "CELL_FORMAT_DATETIME_MDYY_TTAM - Date-Time format, m/d/yy\ h:mm\ AM/PM;@")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_DATETIME_MDYY_TT24)
this.SetCellValue(lnWb, lnSh3, 34, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 34, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 34, 2, "CELL_FORMAT_DATETIME_MDYY_TT24 - Date-Time format, m/d/yy\ h:mm;@")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_COMMA_INTEGER_PAREN)
this.SetCellValue(lnWb, lnSh3, 36, 1, -89235)
this.SetCellStyle(lnWb, lnSh3, 36, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 36, 2, "CELL_FORMAT_COMMA_INTEGER_PAREN - Numeric format, #,##0;(#,##0)")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_COMMA_INTEGER_RED_PAREN)
this.SetCellValue(lnWb, lnSh3, 37, 1, -12457)
this.SetCellStyle(lnWb, lnSh3, 37, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 37, 2, "CELL_FORMAT_COMMA_INTEGER_RED_PAREN - Numeric format, #,##0;[Red](#,##0)")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_COMMA_FLOAT_PAREN)
this.SetCellValue(lnWb, lnSh3, 38, 1, -1245789.22)
this.SetCellStyle(lnWb, lnSh3, 38, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 38, 2, "CELL_FORMAT_COMMA_FLOAT_PAREN - Numeric format, #,##0.00;(#,##0.00)")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_COMMA_FLOAT_RED_PAREN)
this.SetCellValue(lnWb, lnSh3, 39, 1, -125896.33)
this.SetCellStyle(lnWb, lnSh3, 39, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 39, 2, "CELL_FORMAT_COMMA_FLOAT_RED_PAREN - Numeric format, #,##0.00;[Red](#,##0.00)")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_TIME_MMSS)
this.SetCellValue(lnWb, lnSh3, 41, 1, 6.25E-2)
this.SetCellStyle(lnWb, lnSh3, 41, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 41, 2, "CELL_FORMAT_TIME_MMSS - Time format")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_TIME_H_MMSS)
this.SetCellValue(lnWb, lnSh3, 42, 1, 0.35733796296296294)
this.SetCellStyle(lnWb, lnSh3, 42, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 42, 2, "CELL_FORMAT_TIME_H_MMSS - Time format, [h]:mm:ss")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_ACC_CURR_US_PAREN)
this.SetCellValue(lnWb, lnSh3, 44, 1, -445675.55)
this.SetCellStyle(lnWb, lnSh3, 44, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 44, 2, "CELL_FORMAT_TIME_H_MMSS - CELL_FORMAT_ACC_CURR_US_PAREN")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_CURRENCY_RED)
this.SetCellValue(lnWb, lnSh3, 45, 1, -45.55)
this.SetCellStyle(lnWb, lnSh3, 45, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 45, 2, "CELL_FORMAT_CURRENCY_RED")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_ACC_CURR_POUNDS)
this.SetCellValue(lnWb, lnSh3, 46, 1, -45.55)
this.SetCellStyle(lnWb, lnSh3, 46, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 46, 2, "CELL_FORMAT_ACC_CURR_POUNDS")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_ACC_CURR_EURO)
this.SetCellValue(lnWb, lnSh3, 47, 1, -45.55)
this.SetCellStyle(lnWb, lnSh3, 47, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 47, 2, "CELL_FORMAT_ACC_CURR_EURO")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_CURR_EURO_RED)
this.SetCellValue(lnWb, lnSh3, 48, 1, -45.55)
this.SetCellStyle(lnWb, lnSh3, 48, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 48, 2, "CELL_FORMAT_CURR_EURO_RED")
lnStyle = this.CreateFormatStyle(lnWb)
this.AddStyleCellFormat(lnWb, lnStyle, CELL_FORMAT_CURR_POUNDS_RED)
this.SetCellValue(lnWb, lnSh3, 49, 1, -45.55)
this.SetCellStyle(lnWb, lnSh3, 49, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 49, 2, "CELL_FORMAT_CURR_POUNDS_RED")
lnStyle = this.CreateFormatStyle(lnWb)
lnFormat = this.AddCustomDateTimeFormat(lnWb, 'dd mmm yy')
this.AddStyleCellFormat(lnWb, lnStyle, lnFormat)
this.SetCellValue(lnWb, lnSh3, 51, 1, DATE())
this.SetCellStyle(lnWb, lnSh3, 51, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 51, 2, "dd mmm yy [custom defined]")
lnStyle = this.CreateFormatStyle(lnWb)
lnFormat = this.AddCustomDateTimeFormat(lnWb, 'dd/mmm/yyyy\ h:mm;@')
this.AddStyleCellFormat(lnWb, lnStyle, lnFormat)
this.SetCellValue(lnWb, lnSh3, 52, 1, DATETIME())
this.SetCellStyle(lnWb, lnSh3, 52, 1, lnStyle)
this.SetCellValue(lnWb, lnSh3, 52, 2, "dd/mmm/yyyy\ h:mm;@ [custom defined]")
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))
lnStyle3 = this.CreateFormatStyle(lnWB) && Create the base style definition
this.AddStyleFill(lnWB, lnStyle3, RGB(51,102,255), RGB(51,102,255), FILL_STYLE_SOLID) && Fill Solid off-blue backgrond and foreground (foreground is ignored when solid)
this.AddStyleFont(lnWB, lnStyle3, , , , , RGB(255,0,0)) && Font red foreground
this.SetCellStyle(lnWb, lnSh4, 2, 1, lnStyle3)
this.SetCellValue(lnWb, lnSh4, 2, 1, "Fill Using Styles")
lnStyle4 = this.CreateFormatStyle(lnWB) && Create the base style definition
this.AddStyleFill(lnWB, lnStyle4, RGB(255,0,0), RGB(255,0,0), FILL_STYLE_SOLID) && Fill Solid Red background and foreground (foreground is ignored when solid)
this.AddStyleFont(lnWB, lnStyle4, , , , , RGB(255,255,255)) && Font White foreground
this.SetCellStyle(lnWb, lnSh4, 2, 2, lnStyle4)
this.SetCellValue(lnWb, lnSh4, 2, 2, "Fill Using Styles")
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, "Image Example")
IF lnSh6 > 0
lcImageFile = ADDBS(SYS(5) + SYS(2003)) + "vfpxbanner.gif" && Must provide full path
lnImgId = this.AddImage(lnWb, lnSh6, lcImageFile, IMAGE_ANCHOR_TYPE_TWO) && Positioned by defaults A1 cell
IF lnImgId = 0
WAIT WINDOW "Add Image Failed" NOWAIT
this.DeleteSheet(lnWb, lnSh6)
ENDIF
ENDIF
*******************************************************************************
lnSh7 = this.AddSheet(lnWb, "List Values", HIDDEN_SHEET_STATE)
IF lnSh7 = 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")
lnCellXfsId = this.GetCellStyle(lnWb, lnSh1, 13, 2)
lnCellXfsId = this.CopyStyle(lnWb, lnCellXfsId)
this.AddStyleProtection(lnWb, lnCellXfsId, 0, 0) && unlock the cell protected state
this.SetCellStyle(lnWb, lnSh1, 13, 1, lnCellXfsId)
this.SetCellValue(lnWb, lnSh7, 1, 1, "Named Value List")
this.SetCellValue(lnWb, lnSh7, 2, 1, "Named Value 1")
this.SetCellValue(lnWb, lnSh7, 3, 1, "Named Value 2")
this.SetCellValue(lnWb, lnSh7, 4, 1, "Named Value 3")
this.SetCellValue(lnWb, lnSh7, 5, 1, "Named Value 4")
this.SetCellValue(lnWb, lnSh7, 6, 1, "Named Value 5")
this.SetCellValue(lnWb, lnSh7, 7, 1, "Named Value 6")
lcNamedRange = this.AddNamedRange(lnWb, lnSh7, "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)")
lnCellXfsId = this.GetCellStyle(lnWb, lnSh1, 14, 1)
lnCellXfsId = this.CopyStyle(lnWb, lnCellXfsId)
this.AddStyleProtection(lnWb, lnCellXfsId, 0, 0) && unlock the cell protected state
this.SetCellStyle(lnWb, lnSh1, 14, 1, lnCellXfsId)
*-* For testing sheet saving only
*this.DeleteSheet(lnWb, lnSh2)
*-* Set sheet protection on for sheet1
*loProtection = this.GetSheetProtection(lnWb, lnSh1) && use this method to get the protection object structure to be passed to SetSheetProtection()
*loProtection.Locked = True
*this.SetSheetProtection(lnWb, lnSh1, loProtection)
*this.SetSheetProtection(lnWb, lnSh2, loProtection) && If set then the filter is not usable...
*-* Protect the workbook
*this.SetWorkbookProtection(lnWb, True)
*-* Save the workbook
this.SaveWorkbook(lnWb)
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
LOCAL loException
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_columns')
USE IN SELECT('xl_hdrfooterdefn')
USE IN SELECT('xl_hdrfootertext')
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')
USE IN SELECT('xl_hyperlinks')
USE IN SELECT('xl_contenttypes')
USE IN SELECT('xl_images')
USE IN SELECT('xl_shapes')
USE IN SELECT('xl_shptext')
USE IN SELECT('xl_filters')
USE IN SELECT('xl_formulas')
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
PROTECTED PROCEDURE FastExtract && Fast String Replacement for STREXTRACT() function
LPARAMETERS toString, tcBegDelimiter, tcEndDelimiter, tnOccurrence
LOCAL lnBeg, lcVal, lnEnd, lnBegLen, lnEndLen, lnOccurrence
DO CASE
CASE PCOUNT() = 1
RETURN ""
CASE PCOUNT() = 2
tcEndDelimiter = tcBegDelimiter
tnOccurrence = 1
CASE PCOUNT() = 3
tnOccurrence = 1
ENDCASE
lnBegLen = LEN(tcBegDelimiter)
lnEndLen = LEN(tcEndDelimiter)
lnOccurrence = 0
lnBeg = 1
DO WHILE lnBeg < toString.Length
lcVal = SYS(2600, toString.BaseAdr-1 + lnBeg, lnBegLen)
IF lcVal == tcBegDelimiter
FOR lnEnd=lnBeg+lnBegLen TO toString.Length
lcVal = SYS(2600, toString.BaseAdr-1 + lnEnd, lnEndLen)
IF lcVal == tcEndDelimiter
lnOccurrence = lnOccurrence + 1
IF lnOccurrence = tnOccurrence
RETURN SYS(2600, toString.BaseAdr-1 + lnBeg, lnEnd - lnBeg + lnEndLen + 1)
ENDIF
lnBeg = lnEnd - 1
EXIT
ENDIF
ENDFOR
ENDIF
lnBeg = lnBeg + 1
ENDDO
RETURN ""
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, lcBaseCol, lcBaseRow, lcParsedFormula, lnNdx, lcSharedFormula, lnCnt
IF PCOUNT() < 4
RETURN .NULL.
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnCellRow)+BINTOC(tnCellCol), "xl_formulas", "cell")
lcFormula = ALLTRIM(xl_formulas.cellformula)
IF EMPTY(lcFormula)
DO CASE
CASE xl_formulas.formulatype = "shared"
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(xl_formulas.si), "xl_formulas", "si")
lcParsedFormula = ALLTRIM(xl_formulas.parsed)
lcSharedFormula = ALLTRIM(xl_formulas.cellformula)
DO CASE
CASE xl_formulas.formrel = SHARED_FORMULA_COLUMN
IF EMPTY(lcParsedFormula)
lnCnt = 1
lcBaseCol = this.ColumnIndexToAscii(xl_formulas.cellcol)
lnNdx = ATC(lcBaseCol, lcSharedFormula, lnCnt)
DO WHILE True
IF !ISALPHA(SUBSTR(lcSharedFormula, lnNdx-1, 1)) .AND. ISDIGIT(SUBSTR(lcSharedFormula, lnNdx+LEN(lcBaseCol), 1))
lcParsedFormula = lcParsedFormula + LEFT(lcSharedFormula, lnNdx-1) + "*!*"
lcSharedFormula = SUBSTR(lcSharedFormula, lnNdx+LEN(lcBaseCol))
lnCnt = 1
ELSE
lnCnt = lnCnt + 1
ENDIF
IF EMPTY(lcSharedFormula)
EXIT
ENDIF
lnNdx = ATC(lcBaseCol, lcSharedFormula, lnCnt)
IF lnNdx = 0
lcParsedFormula = lcParsedFormula + lcSharedFormula
EXIT
ENDIF
ENDDO
REPLACE xl_formulas.parsed WITH lcParsedFormula IN xl_formulas
lcFormula = STRTRAN(lcParsedFormula, "*!*", TRANSFORM(tnCellRow))
ELSE
lcFormula = STRTRAN(lcParsedFormula, "*!*", this.ColumnIndexToAscii(tnCellCol))
ENDIF
CASE xl_formulas.formrel = SHARED_FORMULA_ROW
IF EMPTY(lcParsedFormula)
lnCnt = 1
lcBaseRow = TRANSFORM(xl_formulas.cellrow)
lnNdx = ATC(lcBaseRow, lcSharedFormula, lnCnt)
DO WHILE True
IF lnNdx > 1 .AND. !ISDIGIT(SUBSTR(lcSharedFormula, lnNdx-1, 1)) .AND. !ISDIGIT(SUBSTR(lcSharedFormula, lnNdx+LEN(lcBaseRow), 1))
lcParsedFormula = lcParsedFormula + LEFT(lcSharedFormula, lnNdx-1) + "*!*"
lcSharedFormula = SUBSTR(lcSharedFormula, lnNdx+LEN(lcBaseRow))
lnCnt = 1
ELSE
lnCnt = lnCnt + 1
ENDIF
IF EMPTY(lcSharedFormula)
EXIT
ENDIF
lnNdx = ATC(lcBaseRow, lcSharedFormula, lnCnt)
IF lnNdx = 0
lcParsedFormula = lcParsedFormula + lcSharedFormula
EXIT
ENDIF
ENDDO
REPLACE xl_formulas.parsed WITH lcParsedFormula IN xl_formulas
lcFormula = STRTRAN(lcParsedFormula, "*!*", TRANSFORM(tnCellRow))
ELSE
lcFormula = STRTRAN(lcParsedFormula, "*!*", TRANSFORM(tnCellRow))
ENDIF
ENDCASE
ELSE
SET STEP ON && For debugging; will be ignored in run-time environment
ENDIF
CASE xl_formulas.formulatype = "array"
CASE xl_formulas.formulatype = "dataTable"
ENDCASE
ENDIF
ELSE
lcFormula = ""
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)
IF SEEK(BINTOC(tnWB)+BINTOC(xl_cellxfs.numFmtId), "xl_numfmts", "id")
lcFormatCode = ALLTRIM(xl_numfmts.formatcode)
ENDIF
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_TEXT
lxValue = ALLTRIM(xl_cells.cellvalue)
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 xl_cells.stringid > -1
IF this.GetCursorRecord("xl_strings", tnWB, xl_cells.stringid)
lxValue = RTRIM(xl_strings.stringval)
ELSE
lxValue = ""
ENDIF
ELSE
lxValue = ALLTRIM(xl_cells.cellvalue)
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, tnIndent, tnWrapText, tnRotation
LOCAL lnCellXfsId
IF SEEK(BINTOC(tnWB)+BINTOC(tnNumFmtId)+BINTOC(tnFontId)+BINTOC(tnFillId)+BINTOC(tnBorderId)+BINTOC(tnIndent)+BINTOC(tnWrapText)+BINTOC(tnRotation)+ALLTRIM(tcHAlign)+ALLTRIM(tcVAlign), "xl_cellxfs", "cellxfs")
lnCellXfsId = xl_cellxfs.id
ELSE
lnCellXfsId = this.GetNextId(tnWB, 0, 'xl_cellxfs')
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId, borderId, halign, valign, indent, wraptext, rotation, celllocked, cellhidden) ;
VALUES (tnWB, lnCellXfsId, tnNumFmtId, tnFontId, tnFillId, tnBorderId, tcHAlign, tcVAlign, tnIndent, tnWrapText, tnRotation, 1, 0)
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, lcChild
lcElement = STREXTRACT(tcNode, '<', '>', tnChild+1, 1)
lcChild = STREXTRACT(tcNode, '<'+lcElement+'>', '', 1, 5)
IF EMPTY(lcChild)
lcChild = STREXTRACT(tcNode, '<'+lcElement+' ', '', 1, 5)
ENDIF
IF EMPTY(lcChild)
lcChild = STREXTRACT(tcNode, '<'+lcElement+' ', '/>', 1, 5)
ENDIF
RETURN lcChild
ENDPROC
PROCEDURE GetColumnHidden && Returns the column hidden setting
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_columns", "col")
lxReturn = IIF(xl_columns.hidden = 1, True, False)
ELSE
lxReturn = False
ENDIF
ELSE
lxReturn = .NULL.
ENDIF
RETURN lxReturn
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
PROTECTED PROCEDURE GetColumnObject && Gets the column object definition
LPARAMETERS toGridColumn, taTblFields
LOCAL lcFieldName, lnNdx, loColumn, lcValue, lxValue
EXTERNAL ARRAY taTblFields
loColumn = CREATEOBJECT("Empty")
ADDPROPERTY(loColumn, "ControlSource", toGridColumn.ControlSource)
ADDPROPERTY(loColumn, "Format", toGridColumn.Format)
ADDPROPERTY(loColumn, "InputMask", toGridColumn.InputMask)
ADDPROPERTY(loColumn, "FontBold", toGridColumn.FontBold)
ADDPROPERTY(loColumn, "FontItalic", toGridColumn.FontItalic)
ADDPROPERTY(loColumn, "FontName", toGridColumn.FontName)
ADDPROPERTY(loColumn, "FontSize", toGridColumn.FontSize)
ADDPROPERTY(loColumn, "BackColor", toGridColumn.BackColor)
ADDPROPERTY(loColumn, "ForeColor", toGridColumn.ForeColor)
ADDPROPERTY(loColumn, "DynamicProperties", False) && Indicates if any dynamic property is being used
ADDPROPERTY(loColumn, "DynamicAlignment", toGridColumn.DynamicAlignment)
ADDPROPERTY(loColumn, "DynamicFontBold", toGridColumn.DynamicFontBold)
ADDPROPERTY(loColumn, "DynamicFontItalic", toGridColumn.DynamicFontItalic)
ADDPROPERTY(loColumn, "DynamicFontName", toGridColumn.DynamicFontName)
ADDPROPERTY(loColumn, "DynamicFontSize", toGridColumn.DynamicFontSize)
ADDPROPERTY(loColumn, "DynamicBackColor", toGridColumn.DynamicBackColor)
ADDPROPERTY(loColumn, "DynamicForeColor", toGridColumn.DynamicForeColor)
ADDPROPERTY(loColumn, "HeaderCaption", toGridColumn.Header1.Caption)
ADDPROPERTY(loColumn, "HeaderFontBold", toGridColumn.Header1.FontBold)
ADDPROPERTY(loColumn, "HeaderFontItalic", toGridColumn.Header1.FontItalic)
ADDPROPERTY(loColumn, "HeaderFontName", toGridColumn.Header1.FontName)
ADDPROPERTY(loColumn, "HeaderFontSize", toGridColumn.Header1.FontSize)
ADDPROPERTY(loColumn, "Width", this.ConvertPixelsToExcelUnits(toGridColumn.Width) + 0.7109375)
ADDPROPERTY(loColumn, "SumColumn", IIF("SUM" $ toGridColumn.Tag, True, False)) && Indicates to add a column summation
ADDPROPERTY(loColumn, "FormatCode", "") && Cell formatting in xls code
ADDPROPERTY(loColumn, "NumFmtsIndex", 0) && Cell number format reference for formatting in XLSX
ADDPROPERTY(loColumn, "FieldPercent", False) && Field is a percent value
ADDPROPERTY(loColumn, "FieldType", "C")
ADDPROPERTY(loColumn, "FieldWidth", 255)
ADDPROPERTY(loColumn, "FieldDecPlaces", 0)
ADDPROPERTY(loColumn, "ValueStyleId", 0) && Format style Id for column values format
ADDPROPERTY(loColumn, "HeaderStyleId", 0) && Format style Id for column header format
*-* Set the column indicator if Dynamic properties are being used
IF !EMPTY(loColumn.DynamicAlignment)
loColumn.DynamicProperties = True
ELSE
IF !EMPTY(loColumn.DynamicFontBold)
loColumn.DynamicProperties = True
ELSE
IF !EMPTY(loColumn.DynamicFontItalic)
loColumn.DynamicProperties = True
ELSE
IF !EMPTY(loColumn.DynamicFontName)
loColumn.DynamicProperties = True
ELSE
IF !EMPTY(loColumn.DynamicFontSize)
loColumn.DynamicProperties = True
ELSE
IF !EMPTY(loColumn.DynamicBackColor)
loColumn.DynamicProperties = True
ELSE
IF !EMPTY(loColumn.DynamicForeColor)
loColumn.DynamicProperties = True
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
lcFieldName = toGridColumn.ControlSource
lcFieldName = IIF('.' $ lcFieldName, GETWORDNUM(lcFieldName, 2, '.'), lcFieldName)
lnNdx = ASCAN(taTblFields, lcFieldName, 1, ALEN(taTblFields, 1), 1, 15)
IF lnNdx > 0
loColumn.FieldType = taTblFields[lnNdx, 2]
loColumn.FieldWidth = taTblFields[lnNdx, 3]
loColumn.FieldDecPlaces = taTblFields[lnNdx, 4]
ELSE
TRY
lxValue = EVALUATE(toGridColumn.ControlSource)
CATCH
lxValue = .NULL.
ENDTRY
IF ISNULL(lxValue)
SET STEP ON
ELSE
loColumn.FieldType = VARTYPE(lxValue)
DO CASE
CASE loColumn.FieldType $ 'CV'
loColumn.FieldWidth = LEN(lxValue)
CASE loColumn.FieldType $ 'DTY'
loColumn.FieldWidth = 8
CASE loColumn.FieldType $ 'IM'
loColumn.FieldWidth = 4
CASE loColumn.FieldType = 'L'
loColumn.FieldWidth = 1
CASE loColumn.FieldType = 'B'
lcValue = TRANSFORM(lxValue)
loColumn.FieldWidth = 8
loColumn.FieldDecPlaces = LEN(lcValue) - AT('.', lcValue)
CASE loColumn.FieldType $ 'NF'
lcValue = TRANSFORM(lxValue)
loColumn.FieldDecPlaces = LEN(lcValue) - AT('.', lcValue)
loColumn.FieldWidth = 19 - loColumn.FieldDecPlaces
OTHERWISE
SET STEP ON
ENDCASE
ENDIF
ENDIF
RETURN loColumn
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_columns", "col")
lxReturn = xl_columns.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
PROCEDURE GetDisplayGridLines && Gets the display grid line setting for the sheet
LPARAMETERS tnWB, tnSheet
IF PCOUNT() = 2 .AND. this.GetSheetRecord(tnWB, tnSheet)
RETURN IIF(xl_sheets.gridlines=1, True, False)
ELSE
RETURN .NULL.
ENDIF
ENDPROC
PROTECTED PROCEDURE GetDwgPicDefinition && Gets the image drawing settings
LPARAMETERS tcXdrPic, tcDwgFile
LOCAL loXdrPic, lcNvPr, lcXfrm, lcRelationships, lcRelsFile, lcRelsFileName, loException, lcRootPath
loXdrPic = CREATEOBJECT("Empty")
ADDPROPERTY(loXdrPic, "RelId", 0)
ADDPROPERTY(loXdrPic, "GblId", 0)
ADDPROPERTY(loXdrPic, "ImgWidth", 0)
ADDPROPERTY(loXdrPic, "ImgHeight", 0)
ADDPROPERTY(loXdrPic, "ImageFile", "")
ADDPROPERTY(loXdrPic, "ImageName", "")
TRY
lcNvPr = this.GetNodeElement(tcXdrPic, "xdr:cNvPr", 1)
loXdrPic.GblId = CAST(this.GetNodeAttributeValue(lcNvPr, "id") AS I)
loXdrPic.ImageName = this.GetNodeAttributeValue(lcNvPr, "name")
lcBlip = this.GetNodeElement(tcXdrPic, "a:blip", 1)
loXdrPic.RelId = this.GetNodeAttributeValue(lcBlip, "r:embed")
lcXfrm = this.GetNodeElement(tcXdrPic, "a:xfrm", 1)
lcXfrm = this.GetNodeElement(lcXfrm, "a:ext", 1)
loXdrPic.ImgWidth = CAST(this.GetNodeAttributeValue(lcXfrm, "cx") AS I)
loXdrPic.ImgHeight = CAST(this.GetNodeAttributeValue(lcXfrm, "cy") AS I)
lcRelsFileName = STUFF(tcDwgFile, RATC("\", tcDwgFile) + 1, 0, "_rels\") + ".rels"
lcRelsFile = FILETOSTR(lcRelsFileName)
lcRelationships = this.GetNodeElement(lcRelsFile, 'Relationships', 1, False)
lcRootPath = JUSTPATH(lcRelsFileName)
lcRootPath = LEFT(lcRootPath, RATC("\", lcRootPath)-1)
loXdrPic.ImageFile = this.GetTargetFromRelationships(loXdrPic.RelId, lcRootPath, lcRelationships)
loXdrPic.RelId = CAST(SUBSTR(loXdrPic.RelId, 4) AS I)
CATCH TO loException
SET STEP ON
ENDTRY
RETURN loXdrPic
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 GetGridColumnFormat && Gets the grid column format for the cell formatting
LPARAMETER toColumn, tnNumFmtsId, tnWB
LOCAL lnNumFlds, lcFormatCode, lcInputMask, lcWholePart, lcDecPart, lnLenWholePart, lnLenDecPart, lcNonNumeric
LOCAL lcTempCode, lnNdx, lcChr, lcDollarSign
LOCAL ARRAY laFields[1, 5]
DO CASE
CASE toColumn.FieldType = "C"
toColumn.NumFmtsIndex = 0
CASE toColumn.FieldType = "D"
DO CASE
CASE EMPTY(toColumn.Format)
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_MMDDYY
CASE toColumn.Format = "D"
DO CASE
CASE SET('DATE') = 'AMERICAN'
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
toColumn.FormatCode = 'd\.m\.yy;@'
CASE SET('DATE') = 'ANSI'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_MMDDYY
CASE SET('DATE') = 'BRITISH'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_DMMMYY
CASE SET('DATE') = 'FRENCH'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_DMMMYY
CASE SET('DATE') = 'GERMAN'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_DMMMYY
CASE SET('DATE') = 'ITALIAN'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_DMMMYY
CASE SET('DATE') = 'JAPAN'
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
toColumn.FormatCode = 'yyyy/m/d;@'
CASE SET('DATE') = 'USA'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_MMDDYY
CASE SET('DATE') = 'MDY'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_MMDDYY
CASE SET('DATE') = 'DMY'
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_DMMMYY
CASE SET('DATE') = 'YMD'
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
toColumn.FormatCode = 'yyyymmdd'
OTHERWISE
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_MMDDYY
ENDCASE
CASE toColumn.Format = "E"
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_DMMMYY
CASE toColumn.Format = "YS"
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_MMDDYY
CASE toColumn.Format = "YL"
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_DMMMYY
OTHERWISE
toColumn.NumFmtsIndex = CELL_FORMAT_DATE_MMDDYY
ENDCASE
CASE toColumn.FieldType = "L"
toColumn.NumFmtsIndex = 0
CASE toColumn.FieldType $ "NFIBY" .AND. '%' $ toColumn.InputMask
IF '.' $ toColumn.InputMask
toColumn.FieldPercent = True
lcInputMask = CHRTRAN(toColumn.InputMask, '%', '')
IF lcInputMask == "."
toColumn.NumFmtsIndex = CELL_FORMAT_PERCENT_FLOAT
ELSE
lcWholePart = GETWORDNUM(lcInputMask, 1, '.')
lcDecPart = GETWORDNUM(lcInputMask, 2, '.')
lnLenWholePart = LEN(lcWholePart)
lnLenDecPart = LEN(lcDecPart)
DO CASE && Change suggested Doug Hennig
CASE lnLenWholePart = 3 .AND. lnLenDecPart = 2
toColumn.NumFmtsIndex = CELL_FORMAT_PERCENT_FLOAT
CASE lnLenWholePart = 3 .AND. lnLenDecPart = 0
toColumn.NumFmtsIndex = CELL_FORMAT_PERCENT_INTEGER
OTHERWISE
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
toColumn.FormatCode = REPLICATE('#', lnLenWholePart-1) + '0.' + REPLICATE('0', lnLenDecPart) + '%'
ENDCASE
ENDIF
ELSE
toColumn.FieldPercent = True
lcInputMask = CHRTRAN(toColumn.InputMask, '%', '')
IF EMPTY(lcInputMask)
toColumn.NumFmtsIndex = CELL_FORMAT_PERCENT_INTEGER
ELSE
lnLenWholePart = LEN(lcInputMask)
IF lnLenWholePart = 3
toColumn.NumFmtsIndex = CELL_FORMAT_PERCENT_INTEGER
ELSE
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
toColumn.FormatCode = REPLICATE('#', lnLenWholePart) + '%'
ENDIF
ENDIF
ENDIF
CASE toColumn.FieldType $ "NFIB"
DO CASE
CASE EMPTY(toColumn.Format) .OR. toColumn.Format = "R" && No formatting specified; check InputMask property
IF EMPTY(toColumn.InputMask)
toColumn.FormatCode = '#0' + IIF(toColumn.FieldDecPlaces = 0, '', '.' + REPLICATE('0', toColumn.FieldDecPlaces)) && Change by Doug Hennig
ELSE
lcDecPart = GETWORDNUM(toColumn.InputMask, 2, '.')
lcNonNumeric = CHRTRAN(toColumn.InputMask, '!0123456789.,', '')
DO CASE
CASE !EMPTY(lcNonNumeric)
lcTempCode = ""
FOR lnNdx=1 TO LEN(toColumn.InputMask)
lcChr = SUBSTR(toColumn.InputMask, lnNdx, 1)
IF lcChr $ lcNonNumeric
lcTempCode = lcTempCode + '\' + lcChr
ELSE
IF lcChr = '!'
lcTempCode = lcTempCode + '0'
ELSE
lcTempCode = lcTempCode + IIF(lcChr = '.', lcChr, '#')
ENDIF
ENDIF
ENDFOR
toColumn.FormatCode = lcTempCode
CASE EMPTY(lcDecPart) && Bug fix by Doug Hennig
IF ',' $ toColumn.InputMask
toColumn.FormatCode = '#,##0'
ELSE
toColumn.FormatCode = '#0'
ENDIF
OTHERWISE && Bug fix by Doug Hennig
lnLenDecPart = LEN(lcDecPart)
IF ',' $ toColumn.InputMask
toColumn.FormatCode = '#,##0' + IIF(lnLenDecPart=0, '', '.' + REPLICATE('0', lnLenDecPart)) && Change by Doug Hennig
ELSE
toColumn.FormatCode = '#0' + IIF(lnLenDecPart=0, '', '.' + REPLICATE('0', lnLenDecPart)) && Change by Doug Hennig
ENDIF
ENDCASE
ENDIF
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
CASE toColumn.Format = "^" && Scientific notation
toColumn.NumFmtsIndex = CELL_FORMAT_EXPONENT
CASE toColumn.Format = "L" && Leading zeros
IF EMPTY(toColumn.InputMask)
lnLenWholePart = toColumn.FieldWidth - toColumn.FieldDecPlaces - IIF(toColumn.FieldDecPlaces>0, 1, 0)
lnLenDecPart = toColumn.FieldDecPlaces
ELSE
lnLenWholePart = LEN(GETWORDNUM(toColumn.InputMask, 1, '.'))
lnLenDecPart = LEN(GETWORDNUM(toColumn.InputMask, 2, '.'))
ENDIF
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
toColumn.FormatCode = REPLICATE('0', lnLenWholePart) + '.' + REPLICATE('0', lnLenDecPart)
CASE toColumn.Format = "$$" && Display floating currency symbol
IF EMPTY(toColumn.InputMask)
DO CASE
CASE this.VFPSettings.Currency = "$"
toColumn.NumFmtsIndex = CELL_FORMAT_CURRENCY_RED_PAREN
CASE this.VFPSettings.Currency = "£"
toColumn.NumFmtsIndex = CELL_FORMAT_CURR_POUNDS_RED
CASE this.VFPSettings.Currency = "€"
toColumn.NumFmtsIndex = CELL_FORMAT_CURR_EURO_RED
OTHERWISE
toColumn.NumFmtsIndex = CELL_FORMAT_CURRENCY_RED_PAREN
ENDCASE
ELSE
lnLenDecPart = LEN(GETWORDNUM(toColumn.InputMask, 2, '.'))
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
IF ',' $ toColumn.InputMask && Change by Doug Hennig
lcFormatCode = '#,##0'
ELSE
lcFormatCode = '#0'
ENDIF
toColumn.FormatCode = '"' + this.VFPSettings.Currency + '"' + lcFormatCode + IIF(lnLenDecPart=0, '', '.' + REPLICATE('0', lnLenDecPart))
ENDIF
CASE toColumn.Format = "$" && Display fixed currency symbol
IF EMPTY(toColumn.InputMask)
DO CASE
CASE this.VFPSettings.Currency = "$"
toColumn.NumFmtsIndex = CELL_FORMAT_ACC_CURR_US_PAREN
CASE this.VFPSettings.Currency = "£"
toColumn.NumFmtsIndex = CELL_FORMAT_ACC_CURR_POUNDS
CASE this.VFPSettings.Currency = "€"
toColumn.NumFmtsIndex = CELL_FORMAT_ACC_CURR_EURO
OTHERWISE
toColumn.NumFmtsIndex = CELL_FORMAT_ACC_CURR_US_PAREN
ENDCASE
ELSE
lnLenDecPart = LEN(GETWORDNUM(toColumn.InputMask, 2, '.'))
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
IF ',' $ toColumn.InputMask && Change by Doug Hennig
lcFormatCode = '#,##0'
ELSE
lcFormatCode = '#0'
ENDIF
toColumn.FormatCode = '_("' + this.VFPSettings.Currency + '"* ' + lcFormatCode + IIF(lnLenDecPart=0, '', '.' + REPLICATE('0', lnLenDecPart)) + '_)'
ENDIF
ENDCASE
CASE toColumn.FieldType = "T"
toColumn.NumFmtsIndex = CELL_FORMAT_DATETIME_DDMMMYYYY_TTAM
CASE toColumn.FieldType = "Y"
IF EMPTY(toColumn.InputMask)
DO CASE
CASE this.VFPSettings.Currency = "$"
toColumn.NumFmtsIndex = CELL_FORMAT_CURRENCY_RED_PAREN
CASE this.VFPSettings.Currency = "£"
toColumn.NumFmtsIndex = CELL_FORMAT_CURR_POUNDS_RED
CASE this.VFPSettings.Currency = "€"
toColumn.NumFmtsIndex = CELL_FORMAT_CURR_EURO_RED
OTHERWISE
toColumn.NumFmtsIndex = CELL_FORMAT_CURRENCY_RED_PAREN
ENDCASE
ELSE
lcDollarSign = IIF("$" $ toColumn.Format, """ + this.VFPSettings.Currency + """, "") && Change by Doug Hennig
lnLenDecPart = LEN(GETWORDNUM(toColumn.InputMask, 2, "."))
tnNumFmtsId = tnNumFmtsId + 1
toColumn.NumFmtsIndex = this.GetNextId(tnWB, 0, "xl_numfmts")
DO CASE
CASE lnLenDecPart > 0 .AND. "," $ toColumn.InputMask
toColumn.FormatCode = lcDollarSign + "#,##0." + REPLICATE("0", lnLenDecPart)
CASE lnLenDecPart > 0 .AND. !("," $ toColumn.InputMask)
toColumn.FormatCode = lcDollarSign + "#0." + REPLICATE("0", lnLenDecPart)
CASE lnLenDecPart = 0 .AND. "," $ toColumn.InputMask
toColumn.FormatCode = lcDollarSign + "#,##0"
CASE lnLenDecPart = 0 .AND. !("," $ toColumn.InputMask)
toColumn.FormatCode = lcDollarSign + "#0"
ENDCASE
ENDIF
ENDCASE
RETURN tnNumFmtsId
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 GetImageDimensions && Gets the image height and width dimensions
LPARAMETERS tcImageFile
LOCAL loSrcImage, loDimens
loSrcImage = _SCREEN.System.Drawing.Image.FromFile(tcImageFile)
IF VARTYPE(loSrcImage) != "O" .OR. loSrcImage.GetLastStatus() != 0
RETURN .NULL.
ENDIF
loDimens = CREATEOBJECT("Empty")
ADDPROPERTY(loDimens, "Width", loSrcImage.Width)
ADDPROPERTY(loDimens, "Height", loSrcImage.Height)
RETURN loDimens
ENDPROC
PROCEDURE GetImageRelationshipId && Gets the image's relationship id
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol
IF PCOUNT() = 6
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnBegRow-1)+BINTOC(tnBegCol-1)+BINTOC(tnEndRow-1)+BINTOC(tnEndCol-1), "xl_images", "position")
RETURN xl_images.relid
ELSE
RETURN 0
ENDIF
ELSE
RETURN 0
ENDIF
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 VARTYPE(laMaxRow[1]) = "N"
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 VARTYPE(laMaxCol[1]) = "N"
lnMaxCol = laMaxCol[1]
ELSE
lnMaxCol = 0
ENDIF
RETURN NVL(lnMaxCol, 0)
ENDPROC
PROCEDURE GetNamedRange && Gets the named range
LPARAMETERS tnWB, tcRangeName
LOCAL lcRangeName, loRange
loRange = CREATEOBJECT("Empty")
ADDPROPERTY(loRange, "BegCol", 0)
ADDPROPERTY(loRange, "BegRow", 0)
ADDPROPERTY(loRange, "EndCol", 0)
ADDPROPERTY(loRange, "EndRow", 0)
ADDPROPERTY(loRange, "SheetId", 0)
lcRangeName = CHRTRAN(ALLTRIM(tcRangeName), " !@#$%^&*()+={}[]|<>,.'?/" + CHR(34), REPLICATE("_", 26))
IF SEEK(BINTOC(tnWB)+PADL(lcRangeName, 50, " "), "xl_namerange", "wbrname")
loRange.BegCol = xl_namerange.begcol
loRange.BegRow = xl_namerange.begrow
loRange.EndCol = xl_namerange.endcol
loRange.EndRow = xl_namerange.endrow
loRange.SheetId = xl_namerange.sheet
ENDIF
RETURN loRange
ENDPROC
PROCEDURE GetNamedRanges && Returns an object listing of all named ranges
LPARAMETERS tnWB
LOCAL lcRangeName, loRanges
loRanges = CREATEOBJECT("Empty")
ADDPROPERTY(loRanges, "List[1]")
ADDPROPERTY(loRanges, "Count", 0)
lnCnt = 0
SELECT xl_namerange
SCAN FOR wb = tnWB
lnCnt = lnCnt + 1
loRanges.Count = lnCnt
DIMENSION loRanges.List[lnCnt]
loRanges.List[lnCnt] = CREATEOBJECT("Empty")
ADDPROPERTY(loRanges.List[lnCnt], "Name", ALLTRIM(xl_namerange.rname))
ADDPROPERTY(loRanges.List[lnCnt], "Comment", ALLTRIM(xl_namerange.comment))
ADDPROPERTY(loRanges.List[lnCnt], "Scope", xl_namerange.scope)
ADDPROPERTY(loRanges.List[lnCnt], "BegCol", xl_namerange.begcol)
ADDPROPERTY(loRanges.List[lnCnt], "BegRow", xl_namerange.begrow)
ADDPROPERTY(loRanges.List[lnCnt], "EndCol", xl_namerange.endcol)
ADDPROPERTY(loRanges.List[lnCnt], "EndRow", xl_namerange.endrow)
ADDPROPERTY(loRanges.List[lnCnt], "SheetId", xl_namerange.sheet)
ENDSCAN
RETURN loRanges
ENDPROC
PROTECTED PROCEDURE GetNextId && Gets the next sequential Id value
LPARAMETERS tnWB, tnSheet, tcCursor
LOCAL lnNdx, lnNextId, lcKey
DO CASE
CASE tcCursor = "global"
lnNdx = ASCAN(this.GlobalId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.GlobalId[lnNdx, 2] = this.GlobalId[lnNdx, 2] + 1
ELSE
IF this.GlobalId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.GlobalId, 1) + 1
ENDIF
DIMENSION this.GlobalId[lnNdx, 2]
this.GlobalId[lnNdx, 1] = tnWB
this.GlobalId[lnNdx, 2] = 2
ENDIF
lnNextId = this.GlobalId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastBorderId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastCellXfsId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastFillId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastFontId[lnNdx, 2]
CASE tcCursor = "xl_sheet_rels"
lcKey = BINTOC(tnWB)+BINTOC(tnSheet)
lnNdx = ASCAN(this.LastSheetRelsId, lcKey, 1, -1, 1, 15)
IF lnNdx > 0
this.LastSheetRelsId[lnNdx, 2] = this.LastSheetRelsId[lnNdx, 2] + 1
ELSE
IF EMPTY(this.LastSheetRelsId[1, 1])
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastSheetRelsId, 1) + 1
ENDIF
DIMENSION this.LastSheetRelsId[lnNdx, 2]
this.LastSheetRelsId[lnNdx, 1] = lcKey
this.LastSheetRelsId[lnNdx, 2] = 1
ENDIF
lnNextId = this.LastSheetRelsId[lnNdx, 2]
CASE tcCursor = "xl_drawing_rels"
lcKey = BINTOC(tnWB)+BINTOC(tnSheet)
lnNdx = ASCAN(this.LastDrawingRelsId, lcKey, 1, -1, 1, 15)
IF lnNdx > 0
this.LastDrawingRelsId[lnNdx, 2] = this.LastDrawingRelsId[lnNdx, 2] + 1
ELSE
IF EMPTY(this.LastDrawingRelsId[1, 1])
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastDrawingRelsId, 1) + 1
ENDIF
DIMENSION this.LastDrawingRelsId[lnNdx, 2]
this.LastDrawingRelsId[lnNdx, 1] = lcKey
this.LastDrawingRelsId[lnNdx, 2] = 1
ENDIF
lnNextId = this.LastDrawingRelsId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastIndexColorId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastMruColorId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastNumFmtId[lnNdx, 2]
CASE tcCursor = "xl_workbook_rels"
lnNdx = ASCAN(this.LastWorkbookRelsId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastWorkbookRelsId[lnNdx, 2] = this.LastWorkbookRelsId[lnNdx, 2] + 1
ELSE
IF this.LastWorkbookRelsId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastWorkbookRelsId, 1) + 1
ENDIF
DIMENSION this.LastWorkbookRelsId[lnNdx, 2]
this.LastWorkbookRelsId[lnNdx, 1] = tnWB
this.LastWorkbookRelsId[lnNdx, 2] = 1
ENDIF
lnNextId = this.LastWorkbookRelsId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastSheetId[lnNdx, 2]
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
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
ENDIF
lnNextId = this.LastStringId[lnNdx, 2]
OTHERWISE
SET STEP ON
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
TRY
IF tlStrict
lcContent = STREXTRACT(tcNode, "<"+tcElement+">", "", tnNode, tnFlag)
ELSE
lcContent = STREXTRACT(tcNode, "<"+tcElement+" ", ">", tnNode, tnFlag)
IF RIGHT(lcContent, 2) != "/>"
lcContent = STREXTRACT(tcNode, "<"+tcElement+" ", "", tnNode, tnFlag)
IF EMPTY(lcContent)
lcContent = STREXTRACT(tcNode, "<"+tcElement+">", "", tnNode, tnFlag)
ENDIF
IF EMPTY(lcContent)
lcContent = STREXTRACT(tcNode, "<"+tcElement, "/>", tnNode, tnFlag)
ENDIF
ENDIF
ENDIF
CATCH TO loException
SET STEP ON
lcContent = ""
ENDTRY
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 GetPrintArea && Gets the sheet print area settings
LPARAMETERS tnWB, tnSheet
LOCAL loPrintArea
LOCAL ARRAY laPrintArea[1, 4]
IF PCOUNT() < 2
RETURN .NULL.
ENDIF
SELECT begcol, begrow, endcol, endrow ;
FROM xl_namerange ;
WHERE workbook = tnWB ;
AND sheet = tnSheet ;
AND rname = PADL("_xlnm.PRINT_AREA", 50, " ") ;
INTO ARRAY laPrintArea
IF _TALLY > 0
loPrintArea = CREATEOBJECT("Empty")
ADDPROPERTY(loPrintArea, "BegCol", laPrintArea[1, 1])
ADDPROPERTY(loPrintArea, "BegRow", laPrintArea[1, 2])
ADDPROPERTY(loPrintArea, "EndCol", laPrintArea[1, 3])
ADDPROPERTY(loPrintArea, "EndRow", laPrintArea[1, 4])
RETURN loPrintArea
ELSE
RETURN .NULL.
ENDIF
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, tnSheet, tnRelId, tcRelsSrc
LOCAL lcFileName
lcFileName = ""
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnRelId)+tcRelsSrc, "xl_relationships", "relidsrc")
lcFileName = ALLTRIM(xl_relationships.target)
ENDIF
RETURN lcFileName
ENDPROC
PROTECTED PROCEDURE GetRelationTypeText && Gets the relation type text from the code
LPARAMETERS tcRelsCode
LOCAL lcRelsText
DO CASE
CASE tcRelsCode = RELS_TYPE_CALCCHAIN
lcRelsText = "calcChain"
CASE tcRelsCode = RELS_TYPE_DRAWING
lcRelsText = "drawing"
CASE tcRelsCode = RELS_TYPE_EXTNLINK
lcRelsText = "externalLink"
CASE tcRelsCode = RELS_TYPE_HYPERLINK
lcRelsText = "hyperlink"
CASE tcRelsCode = RELS_TYPE_IMAGE
lcRelsText = "image"
CASE tcRelsCode = RELS_TYPE_SHAREDSTRINGS
lcRelsText = "sharedStrings"
CASE tcRelsCode = RELS_TYPE_STYLES
lcRelsText = "styles"
CASE tcRelsCode = RELS_TYPE_THEME
lcRelsText = "theme"
CASE tcRelsCode = RELS_TYPE_WORKSHEET
lcRelsText = "worksheet"
OTHERWISE
lcRelsText = ""
ENDCASE
RETURN lcRelsText
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
CASE tcRGB = "S"
RETURN TRANSFORM(INT(GetRGBValues(tnColorValue, 'R'))) + "," + TRANSFORM(INT(GetRGBValues(tnColorValue, 'G'))) + "," + TRANSFORM(INT(GetRGBValues(tnColorValue, 'B')))
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
PROCEDURE GetRowHidden && Gets the row hidden setting
LPARAMETERS tnWB, tnSheet, tnRow
LOCAL lxReturn
IF PCOUNT() < 3
RETURN .NULL.
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnRow), "xl_rows", "row")
lxReturn = IIF(xl_rows.hidden = 1, True, False)
ELSE
lxReturn = False
ENDIF
ELSE
lxReturn = .NULL.
ENDIF
RETURN lxReturn
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 CAST(lcRow AS INTEGER)
ENDPROC
PROCEDURE GetRowMaxColumn && Returns the selected row maximum column
LPARAMETERS tnWB, tnSheet, tnCellRow
SELECT maxcol FROM xl_rows WHERE workbook = tnWB AND sheet = tnSheet AND row = tnCellRow INTO ARRAY laMaxCol
RETURN NVL(laMaxCol[1], 0)
ENDPROC
PROTECTED PROCEDURE GetRowMaxFontSize && Returns the max fontsize used in the row
LPARAMETERS tnWB, tnSheet, tnRow
LOCAL lnFontSize
LOCAL ARRAY laMaxSize[1]
SELECT MAX(c.fsize) FROM xl_cells AS a ;
INNER JOIN xl_cellxfs AS b ON b.id = a.cellxfs ;
INNER JOIN xl_fonts AS c ON c.id = b.fontId ;
WHERE a.workbook = tnWB AND a.sheet = tnSheet AND a.cellrow = tnRow ;
INTO ARRAY laMaxSize
IF _TALLY > 0 .AND. VARTYPE(laMaxSize[1]) = "N" .AND. laMaxSize[1] > 0.0
lnFontSize = laMaxSize[1]
ELSE
lnFontSize = 21.4286
ENDIF
RETURN lnFontSize
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 GetSheetIndex && Gets the sheet internal index from the sheet name
LPARAMETERS tnWB, tcShName
LOCAL lnSheet
LOCAL ARRAY laRecord[1]
SELECT sheet FROM xl_sheets WHERE workbook = tnWB AND PADR(ALLTRIM(shname), 30, "#") = PADR(ALLTRIM(tcShName), 30, "#") INTO ARRAY laRecord
IF VARTYPE(laRecord[1]) = "N"
lnSheet = laRecord[1]
ELSE
lnSheet = 0
ENDIF
RETURN lnSheet
ENDPROC
PROCEDURE GetSheetName && Gets the sheet name
LPARAMETERS tnWB, tnSheet
LOCAL ARRAY laRecord[1]
IF PCOUNT() = 2
SELECT shname FROM xl_sheets WHERE BINTOC(workbook)+BINTOC(sheet) = BINTOC(tnWB)+BINTOC(tnSheet) INTO ARRAY laRecord
IF VARTYPE(laRecord[1]) = "C"
lcSheetName = ALLTRIM(laRecord[1])
ELSE
lcSheetName = ""
ENDIF
ELSE
lcSheetName = ""
ENDIF
RETURN lcSheetName
ENDPROC
PROCEDURE GetSheetProtection && Returns the sheet protection settings
LPARAMETERS tnWB, tnSheet
LOCAL loProtection
loProtection = CREATEOBJECT("Empty")
ADDPROPERTY(loProtection, "Locked", False)
ADDPROPERTY(loProtection, "AlgorithmName", "")
ADDPROPERTY(loProtection, "Password", "")
ADDPROPERTY(loProtection, "AutoFilter", True)
ADDPROPERTY(loProtection, "DeleteColumns", True)
ADDPROPERTY(loProtection, "DeleteRows", True)
ADDPROPERTY(loProtection, "FormatCells", True)
ADDPROPERTY(loProtection, "FormatColumns", True)
ADDPROPERTY(loProtection, "FormatRows", True)
ADDPROPERTY(loProtection, "InsertColumns", True)
ADDPROPERTY(loProtection, "InsertRows", True)
ADDPROPERTY(loProtection, "InsertHyperlinks", True)
ADDPROPERTY(loProtection, "PivotTables", True)
ADDPROPERTY(loProtection, "SelectLockedCells", False)
ADDPROPERTY(loProtection, "SelectUnlockedCells", False)
ADDPROPERTY(loProtection, "Sort", True)
ADDPROPERTY(loProtection, "Objects", True)
ADDPROPERTY(loProtection, "Scenarios", True)
IF this.GetSheetRecord(tnWB, tnSheet)
loProtection.Locked = xl_sheets.protection
loProtection.AlgorithmName = xl_sheets.algorithm
loProtection.Password = xl_sheets.password
loProtection.AutoFilter = xl_sheets.autoFilter
loProtection.DeleteColumns = xl_sheets.deletecol
loProtection.DeleteRows = xl_sheets.deleterow
loProtection.FormatCells = xl_sheets.formatcell
loProtection.FormatColumns = xl_sheets.formatcol
loProtection.FormatRows = xl_sheets.formatrow
loProtection.InsertColumns = xl_sheets.insertcol
loProtection.InsertRows = xl_sheets.insertrow
loProtection.InsertHyperlinks = xl_sheets.inserthyper
loProtection.PivotTables = xl_sheets.Pivottbl
loProtection.SelectLockedCells = xl_sheets.Sellocked
loProtection.SelectUnlockedCells = xl_sheets.Selunlocked
loProtection.Sort = xl_sheets.sort
loProtection.Objects = xl_sheets.objects
loProtection.Scenarios = xl_sheets.scenarios
ENDIF
RETURN loProtection
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", "sheet")
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, '&', CHR(38))
lcString = STRTRAN(lcString, '>', '>')
lcString = STRTRAN(lcString, '<', '<')
lcString = STRTRAN(lcString, '"', '"')
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("" + tcString + "")
lcString = this.oXDOM.Text
ENDIF
CATCH TO loException
SET STEP ON
ENDTRY
RETURN lcString
ENDPROC
PROCEDURE GetStyleFormatId && Gets the format style Id for the given numeric format, font format, and fill format
LPARAMETERS tnWB, tnNumFmtId, tnFillColor, tcFontName, tnFontSize, tlFontBold, tlFontItalic, tnFontColor, tcFontULine, tlFontStrikThr, tcFontVPos
LOCAL lnFontId, lnFillId
IF PCOUNT() < 3
RETURN -1
ENDIF
*-* Validate the font parameters
IF VARTYPE(tcFontName) != 'C' .OR. EMPTY(tcFontName)
tcFontName = 'Calibri'
ENDIF
tcFontName = PROPER(ALLTRIM(tcFontName))
IF VARTYPE(tnFontSize) != 'N' .OR. EMPTY(tnFontSize) .OR. tnFontSize < 0.5
tnFontSize = 11
ELSE
tnFontSize = INT(tnFontSize)
ENDIF
IF VARTYPE(tlFontBold) != 'L'
tlFontBold = False
ENDIF
IF VARTYPE(tlFontItalic) != 'L'
tlFontItalic = False
ENDIF
IF VARTYPE(tnFontColor) = 'N' .AND. BETWEEN(tnFontColor, 0, RGB(255, 255, 255))
tnFontColor = FLOOR(tnFontColor)
ELSE
tnFontColor = RGB(0, 0, 0)
ENDIF
IF VARTYPE(tlFontStrikThr) != 'L'
tlFontStrikThr = False
ENDIF
IF VARTYPE(tcFontULine) != 'C' .OR. !INLIST(tcFontULine, UNDERLINE_SINGLE, UNDERLINE_DOUBLE, UNDERLINE_SINGLEACCOUNTING, UNDERLINE_DOUBLEACCOUNTING, UNDERLINE_NONE)
tcFontULine = UNDERLINE_NONE
ENDIF
IF VARTYPE(tcFontVPos) != 'C' .OR. !INLIST(tcFontVPos, FONT_VERTICAL_BASELINE, FONT_VERTICAL_SUBSCRIPT, FONT_VERTICAL_SUPERSCRIPT)
tcFontVPos = FONT_VERTICAL_BASELINE
ENDIF
*-* Get the font record id
IF SEEK(BINTOC(tnWB)+PADR(tcFontName, 100) + STR(tnFontSize, 5, 1) + TRANSFORM(tlFontBold) + TRANSFORM(tlFontItalic) + PADL(tnFontColor, 15) + PADR(tcFontULine, 16) + ;
TRANSFORM(tlFontStrikThr) + PADR(tcFontVPos, 11), "xl_fonts", "cellformat")
lnFontId = xl_fonts.id
ELSE
lnFontId = this.GetNextId(tnWB, 0, 'xl_fonts')
INSERT INTO xl_fonts (workbook, id, fname, fsize, fbold, fitalic, fcolor, uline, strkthr, fvpos) ;
VALUES (tnWB, lnFontId, tcFontName, tnFontSize, tlFontBold, tlFontItalic, tnFontColor, tcFontULine, tlFontStrikThr, tcFontVPos)
ENDIF
*-* Validate the fill parameter
IF VARTYPE(tnFillColor) = 'N' .AND. BETWEEN(tnFillColor, 0, RGB(255, 255, 255))
tnFillColor = FLOOR(tnFillColor)
ELSE
tnFillColor = RGB(255, 255, 255)
ENDIF
*-* Get the fill record id
IF tnFillColor = RGB(255, 255, 255)
lnFillId = 0
ELSE
IF SEEK(BINTOC(tnWB)+BINTOC(tnFillColor)+BINTOC(tnFillColor)+FILL_STYLE_SOLID, "xl_fills", "fillcolor")
lnFillId = xl_fills.id
ELSE
lnFillId = this.GetNextId(tnWB, 0, 'xl_fills')
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed, fgtheme, bgtheme) ;
VALUES (tnWB, lnFillId, tnFillColor, tnFillColor, FILL_STYLE_SOLID, 0, 0, 0, 0, -1, -1)
ENDIF
ENDIF
*-* Get the style id
IF SEEK(BINTOC(tnWB)+BINTOC(tnNumFmtId)+BINTOC(lnFontId)+BINTOC(lnFillId), "xl_cellxfs", "gridstyle")
lnId = xl_cellxfs.id
ELSE
lnId = this.GetNextId(tnWB, 0, "xl_cellxfs")
INSERT INTO xl_cellxfs (workbook, id, numFmtId, fontId, fillId) ;
VALUES (tnWB, lnId, tnNumFmtId, lnFontId, lnFillId)
ENDIF
RETURN lnId
ENDPROC
PROTECTED PROCEDURE GetTargetFromRelationships && Gets the target (file name) for the relationship id from the passed relationships file
LPARAMETERS tcRId, tcRootPath, tcRelationships
LOCAL lnNode, lcRelationship, lcRId, lcTargetFile
lnNode = 1
lcRelationship = this.GetNodeElement(tcRelationships, 'Relationship', lnNode)
DO WHILE !EMPTY(lcRelationship)
lcRId = this.GetNodeAttributeValue(lcRelationship, "Id")
IF lcRId == tcRId
lcTargetFile = this.GetNodeAttributeValue(lcRelationship, "Target")
lcTargetFile = CHRTRAN(lcTargetFile, "/", "\")
DO WHILE "..\" = LEFT(lcTargetFile, 3) .AND. !EMPTY(tcRootPath)
tcRootPath = LEFT(tcRootPath, RATC("\", tcRootPath)-1)
lcTargetFile = SUBSTR(lcTargetFile, 4)
ENDDO
RETURN IIF(EMPTY(tcRootPath), "", ADDBS(tcRootPath)) + lcTargetFile
ENDIF
lnNode = lnNode + 1
lcRelationship = this.GetNodeElement(tcRelationships, 'Relationship', lnNode)
ENDDO
RETURN .NULL.
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
RETURN lcFileName
ENDPROC
PROCEDURE GetWorkbookProtection && Gets the selected workbook protection
LPARAMETERS tnWB
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
RETURN xl_workbooks.protection
ELSE
RETURN .NULL.
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 GetXMLFirstSegment && Gets the first segment in a XML structure
LPARAMETERS toString, tcBegDelimiter
LOCAL lnBeg, lcVal, lnEnd, lnBegLen, lnEndLen, lcAltDelimiter, lcEndDelimiter, llShort, lcBegDelimiter
toString.XMLDelimiter = ALLTRIM(tcBegDelimiter, 1, "<", ">", " ")
lcAltDelimiter = '<' + toString.XMLDelimiter + " "
lcBegDelimiter = '<' + toString.XMLDelimiter + '>'
lnBegLen = LEN(lcBegDelimiter)
lnBeg = 1
DO WHILE (lnBeg + lnBegLen) <= toString.Length
lcVal = SYS(2600, toString.BaseAdr-1 + lnBeg, lnBegLen)
IF lcVal == lcBegDelimiter .OR. lcVal == lcAltDelimiter
DO CASE
CASE lcVal == lcBegDelimiter
lcEndDelimiter = STUFF(lcBegDelimiter, 2, 0, "/")
llShort = False
CASE lcVal == lcAltDelimiter
lcEndDelimiter = "/>"
llShort = True
ENDCASE
lnEndLen = LEN(lcEndDelimiter)
lnEnd = lnBeg + lnBegLen
DO WHILE (lnEnd + lnEndLen - 1) <= toString.Length
lcVal = SYS(2600, toString.BaseAdr-1 + lnEnd, lnEndLen)
DO CASE
CASE lcVal = "<" .AND. !(lcVal == lcEndDelimiter)
DO WHILE lcVal != ">" .AND. lnEnd <= toString.Length
lnEnd = lnEnd + 1
lcVal = SYS(2600, toString.BaseAdr-1 + lnEnd, 1)
ENDDO
CASE llShort .AND. lcVal = ">"
lcEndDelimiter = STUFF(lcBegDelimiter, 2, 0, "/")
lnEndLen = LEN(lcEndDelimiter)
llShort = False
CASE lcVal == lcEndDelimiter
toString.LastAdr = lnEnd + lnEndLen
RETURN SYS(2600, toString.BaseAdr-1 + lnBeg, lnEnd - lnBeg + lnEndLen)
ENDCASE
lnEnd = lnEnd + 1
ENDDO
lnBeg = toString.Length
ENDIF
lnBeg = lnBeg + 1
ENDDO
toString.LastAdr = toString.Length
RETURN ""
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 + '&' + TRANSFORM(xl_hdrfootertext.fontsize)
ENDIF
IF xl_hdrfootertext.fontcolor > 0
lcText = lcText + '&K' + this.ConvertColorToHex(xl_hdrfootertext.fontcolor)
ENDIF
lcText = lcText + ALLTRIM(xl_hdrfootertext.text)
RETURN lcText
ENDPROC
PROTECTED PROCEDURE GetXMLNextSegment && Gets the next XML Segment in a XML structure
LPARAMETERS toString
LOCAL lnBeg, lcVal, lnEnd, lnBegLen, lnEndLen, lcAltDelimiter, lcEndDelimiter, llShort, lcBegDelimiter
lcAltDelimiter = '<' + toString.XMLDelimiter + " "
lcBegDelimiter = '<' + toString.XMLDelimiter + '>'
lnBegLen = LEN(lcBegDelimiter)
lnBeg = toString.LastAdr
DO WHILE (lnBeg + lnBegLen) <= toString.Length
lcVal = SYS(2600, toString.BaseAdr-1 + lnBeg, lnBegLen)
IF lcVal == lcBegDelimiter .OR. lcVal == lcAltDelimiter
DO CASE
CASE lcVal == lcBegDelimiter
lcEndDelimiter = STUFF(lcBegDelimiter, 2, 0, "/")
llShort = False
CASE lcVal == lcAltDelimiter
lcEndDelimiter = "/>"
llShort = True
ENDCASE
lnEndLen = LEN(lcEndDelimiter)
lnEnd = lnBeg + lnBegLen
DO WHILE (lnEnd + lnEndLen - 1) <= toString.Length
lcVal = SYS(2600, toString.BaseAdr-1 + lnEnd, lnEndLen)
DO CASE
CASE lcVal = "<" .AND. !(lcVal == lcEndDelimiter)
DO WHILE lcVal != ">" .AND. lnEnd <= toString.Length
lnEnd = lnEnd + 1
lcVal = SYS(2600, toString.BaseAdr-1 + lnEnd, 1)
ENDDO
CASE llShort .AND. lcVal = ">"
lcEndDelimiter = STUFF(lcBegDelimiter, 2, 0, "/")
lnEndLen = LEN(lcEndDelimiter)
llShort = False
CASE lcVal == lcEndDelimiter
toString.LastAdr = lnEnd + lnEndLen
RETURN SYS(2600, toString.BaseAdr-1 + lnBeg, lnEnd - lnBeg + lnEndLen)
ENDCASE
lnEnd = lnEnd + 1
ENDDO
lnBeg = toString.Length
ENDIF
lnBeg = lnBeg + 1
ENDDO
toString.LastAdr = toString.Length
RETURN ""
ENDPROC
PROTECTED PROCEDURE GetXMLSegment && Gets the selected XML Segment
LPARAMETERS txString, tcBegDelimiter
LOCAL lnBeg, lcVal, lnEnd, lnBegLen, lnEndLen, lcAltDelimiter, lcEndDelimiter, lcRtnSegment, loString
LOCAL llReleaseHeap, lcBegDelimiter
lcRtnSegment = ""
tcBegDelimiter = ALLTRIM(tcBegDelimiter, 1, "<", ">", " ")
lcAltDelimiter = '<' + tcBegDelimiter + " "
lcBegDelimiter = '<' + tcBegDelimiter + '>'
lnBegLen = LEN(lcBegDelimiter)
DO CASE
CASE VARTYPE(txString) = 'C'
llReleaseHeap = True
loString = this.AddStringToHeap(txString)
CASE VARTYPE(txString) = 'O'
llReleaseHeap = False
loString = txString
OTHERWISE
RETURN ""
ENDCASE
lnBeg = 1
DO WHILE (lnBeg + lnBegLen) < loString.Length
lcVal = SYS(2600, loString.BaseAdr-1 + lnBeg, lnBegLen)
IF lcVal == lcBegDelimiter .OR. lcVal == lcAltDelimiter
DO CASE
CASE lcVal == lcBegDelimiter
lcEndDelimiter = STUFF(lcBegDelimiter, 2, 0, "/")
llShort = False
CASE lcVal == lcAltDelimiter
lcEndDelimiter = "/>"
llShort = True
ENDCASE
lnEndLen = LEN(lcEndDelimiter)
lnEnd = lnBeg + lnBegLen
DO WHILE (lnEnd + lnEndLen - 1) < loString.Length
lcVal = SYS(2600, loString.BaseAdr-1 + lnEnd, lnEndLen)
DO CASE
CASE lcVal = "<" .AND. !(lcVal == lcEndDelimiter)
DO WHILE lcVal != ">" .AND. lnEnd < loString.Length
lnEnd = lnEnd + 1
lcVal = SYS(2600, loString.BaseAdr-1 + lnEnd, 1)
ENDDO
CASE llShort .AND. lcVal = ">"
lcEndDelimiter = STUFF(lcBegDelimiter, 2, 0, "/")
lnEndLen = LEN(lcEndDelimiter)
llShort = False
CASE lcVal == lcEndDelimiter
lcRtnSegment = SYS(2600, loString.BaseAdr-1 + lnBeg, lnEnd - lnBeg + lnEndLen)
IF llReleaseHeap
this.ReleaseStringFromHeap(loString)
ENDIF
RETURN lcRtnSegment
ENDCASE
lnEnd = lnEnd + 1
ENDDO
lnBeg = loString.Length
ENDIF
lnBeg = lnBeg + 1
ENDDO
IF llReleaseHeap
this.ReleaseStringFromHeap(loString)
ENDIF
RETURN ""
ENDPROC
PROTECTED PROCEDURE GetXMLSegmentEx && Returns the selected XML Segment
LPARAMETERS toXML, tcVal, tcSegment, tnBeg
LOCAL loSegment, lcEndDelimiter, llShort, lnEndLen, lnEnd, lcVal, loException
loSegment = CREATEOBJECT('Empty')
ADDPROPERTY(loSegment, "Segment", "")
ADDPROPERTY(loSegment, "End", 0)
*-* Check if the segment does not contain any content or attributes; i.e.
IF SUBSTR(tcVal, LEN(tcSegment)-1, 1) = "/"
loSegment.End = tnBeg + LEN(tcVal)
RETURN loSegment
ENDIF
*-* Set the segment end delimiter to search for
IF SUBSTR(tcVal, LEN(tcSegment)-1, 1) = ">"
lcEndDelimiter = tcSegment
llShort = False
ELSE
lcEndDelimiter = "/>"
llShort = True
ENDIF
TRY
lnEndLen = LEN(lcEndDelimiter)
lnEnd = tnBeg + LEN(tcSegment) - 1
DO WHILE (lnEnd + lnEndLen - 1) < toXML.Length
lcVal = SYS(2600, toXML.BaseAdr-1 + lnEnd, lnEndLen)
DO CASE
CASE lcVal = "<" .AND. !(lcVal == lcEndDelimiter)
DO WHILE lcVal != ">" .AND. lnEnd < toXML.Length
lnEnd = lnEnd + 1
lcVal = SYS(2600, toXML.BaseAdr-1 + lnEnd, 1)
ENDDO
CASE llShort .AND. lcVal = ">"
lcEndDelimiter = tcSegment
lnEndLen = LEN(lcEndDelimiter)
llShort = False
CASE lcVal == lcEndDelimiter
loSegment.Segment = SYS(2600, toXML.BaseAdr-1 + tnBeg, lnEnd - tnBeg + lnEndLen)
EXIT
ENDCASE
lnEnd = lnEnd + 1
ENDDO
loSegment.End = lnEnd
CATCH TO loException
SET STEP ON
ENDTRY
RETURN loSegment
ENDPROC
PROTECTED PROCEDURE GetXMLString && Gets the string as an XML formatted string
LPARAMETERS tcString
LOCAL lcString, lcXMLString, lnNdx, lcChar, lcInvalidChars, loNodeText
*-* 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 EMPTY(lcString)
RETURN ""
ENDIF
IF ISNULL(this.oXDOM)
lcString = STRTRAN(lcString, CHR(38), '&')
lcString = STRTRAN(lcString, '>', '>')
lcString = STRTRAN(lcString, '<', '<')
lcString = STRTRAN(lcString, '"', '"')
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, '"', '"')
ENDIF
RETURN lcXMLString
ENDPROC
PROTECTED PROCEDURE Init
LPARAMETERS tnCodePage
LOCAL loException, lnSelect
IF PCOUNT() > 0 .AND. VARTYPE(tnCodePage) = "N"
this.CodePage = tnCodePage
ENDIF
this.VFPSettings = CREATEOBJECT("Empty")
ADDPROPERTY(this.VFPSettings, "ValuesSet", False)
ADDPROPERTY(this.VFPSettings, "Alias", "")
ADDPROPERTY(this.VFPSettings, "Currency", "")
ADDPROPERTY(this.VFPSettings, "Exact", "")
ADDPROPERTY(this.VFPSettings, "Safety", "")
ADDPROPERTY(this.VFPSettings, "SetDeleted", "")
ADDPROPERTY(this.VFPSettings, "SetPoint", "")
ADDPROPERTY(this.VFPSettings, "Separator", "")
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.GlobalId[1, 2]
this.GlobalId[1, 1] = 0 && Workbook Id
this.GlobalId[1, 2] = 1 && Last Global Id
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.LastSheetRelsId[1, 2]
this.LastSheetRelsId[1, 1] = "" && BINTOC(tnWB)+BINTOC(tnSheet)
this.LastSheetRelsId[1, 2] = 0 && Last drawing Id
DIMENSION this.LastDrawingRelsId[1, 2]
this.LastDrawingRelsId[1, 1] = "" && BINTOC(tnWB)+BINTOC(tnSheet)
this.LastDrawingRelsId[1, 2] = 0 && Last Image 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] = START_NUMERIC_FORMAT_ID && Last NumFmt Id
DIMENSION this.LastWorkbookRelsId[1, 2]
this.LastWorkbookRelsId[1, 1] = 0 && Workbook Id
this.LastWorkbookRelsId[1, 2] = 0 && Last Workbook 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
LOCAL ARRAY laCellXfs[1], laColRecord[1]
IF PCOUNT() < 4
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
DO CASE
CASE tnShift = INSERT_LEFT
SELECT xl_cells
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", "row") .AND. xl_cells.cellcol > xl_rows.maxcol
REPLACE xl_rows.maxcol WITH xl_cells.cellcol IN xl_rows
ENDIF
ENDSCAN
SELECT cellrow, cellxfs FROM xl_cells WHERE workbook = tnWB AND sheet = tnSheet AND cellcol = tnCol-1 INTO CURSOR t_cells
IF _TALLY > 0
SELECT t_cells
SCAN
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs) ;
VALUES (tnWB, tnSheet, t_cells.cellrow, tnCol, DATA_TYPE_NONE, t_cells.cellxfs)
ENDSCAN
ENDIF
USE IN SELECT('t_cells')
REPLACE xl_columns.col WITH xl_columns.col + 1 FOR xl_columns.workbook = tnWB .AND. xl_columns.sheet = tnSheet .AND. xl_columns.col >= tnCol IN xl_columns
SELECT width, bestfit, collevel, collapsed FROM xl_columns WHERE workbook = tnWB AND sheet = tnSheet AND col = tnCol-1 INTO ARRAY laColRecord
IF VARTYPE(laColRecord[1,1]) = "N"
INSERT INTO xl_columns (workbook, sheet, col, width, bestfit, collevel, collapsed) ;
VALUES (tnWB, tnSheet, tnCol, laColRecord[1,1], laColRecord[1,2], laColRecord[1,3], laColRecord[1,4])
ENDIF
llReturn = True
CASE tnShift = INSERT_RIGHT
SELECT xl_cells
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", "row") .AND. xl_cells.cellcol > xl_rows.maxcol
REPLACE xl_rows.maxcol WITH xl_cells.cellcol IN xl_rows
ENDIF
ENDSCAN
SELECT cellrow, cellxfs FROM xl_cells WHERE workbook = tnWB AND sheet = tnSheet AND cellcol = tnCol INTO CURSOR t_cells
IF _TALLY > 0
SELECT t_cells
SCAN
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs) ;
VALUES (tnWB, tnSheet, t_cells.cellrow, tnCol+1, DATA_TYPE_NONE, t_cells.cellxfs)
ENDSCAN
ENDIF
USE IN SELECT('t_cells')
REPLACE xl_columns.col WITH xl_columns.col + 1 FOR xl_columns.workbook = tnWB .AND. xl_columns.sheet = tnSheet .AND. xl_columns.col > tnCol IN xl_columns
SELECT width, bestfit, collevel, collapsed FROM xl_columns WHERE workbook = tnWB AND sheet = tnSheet AND col = tnCol INTO ARRAY laColRecord
IF VARTYPE(laColRecord[1,1]) = "N"
INSERT INTO xl_columns (workbook, sheet, col, width, bestfit, collevel, collapsed) ;
VALUES (tnWB, tnSheet, tnCol+1, laColRecord[1,1], laColRecord[1,2], laColRecord[1,3], laColRecord[1,4])
ENDIF
llReturn = True
OTHERWISE
llReturn = False
ENDCASE
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE InsertRow && Inserts a new row into the sheet
LPARAMETERS tnWB, tnSheet, tnRow, tnShift
LOCAL llReturn, lnRow, lnNumCellRecs, lnTally
LOCAL ARRAY laCellXfs[1], laRowRecord[1]
IF PCOUNT() < 4
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
DO CASE
CASE tnShift = INSERT_BEFORE
REPLACE xl_cells.cellrow WITH xl_cells.cellrow + 1 FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSheet .AND. xl_cells.cellrow >= tnRow IN xl_cells
SELECT cellcol, cellxfs FROM xl_cells WHERE workbook = tnWB AND sheet = tnSheet AND cellrow = tnRow+1 INTO CURSOR t_cells
IF _TALLY > 0
SELECT t_cells
SCAN
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs) ;
VALUES (tnWB, tnSheet, tnRow, t_cells.cellcol, DATA_TYPE_NONE, t_cells.cellxfs)
ENDSCAN
ENDIF
USE IN SELECT('t_cells')
REPLACE xl_rows.row WITH xl_rows.row + 1 FOR xl_rows.workbook = tnWB .AND. xl_rows.sheet = tnSheet .AND. xl_rows.row >= tnRow IN xl_rows
SELECT maxcol, height, rowlevel, collapsed FROM xl_rows WHERE workbook = tnWB AND sheet = tnSheet AND row = tnRow+1 INTO ARRAY laRowRecord
INSERT INTO xl_rows (workbook, sheet, row, maxcol, height, rowlevel, collapsed, hidden) ;
VALUES (tnWB, tnSheet, tnRow, NVL(laRowRecord[1, 1], 1), NVL(laRowRecord[1, 2], -1), NVL(laRowRecord[1, 3], 0), NVL(laRowRecord[1, 4], False), 0)
llReturn = True
CASE tnShift = INSERT_AFTER
REPLACE xl_cells.cellrow WITH xl_cells.cellrow + 1 FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSheet .AND. xl_cells.cellrow > tnRow IN xl_cells
SELECT cellcol, cellxfs FROM xl_cells WHERE workbook = tnWB AND sheet = tnSheet AND cellrow = tnRow INTO CURSOR t_cells
IF _TALLY > 0
SELECT t_cells
SCAN
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, cellxfs) ;
VALUES (tnWB, tnSheet, tnRow+1, t_cells.cellcol, DATA_TYPE_NONE, t_cells.cellxfs)
ENDSCAN
ENDIF
USE IN SELECT('t_cells')
REPLACE xl_rows.row WITH xl_rows.row + 1 FOR xl_rows.workbook = tnWB .AND. xl_rows.sheet = tnSheet .AND. xl_rows.row > tnRow IN xl_rows
SELECT maxcol, height, rowlevel, collapsed FROM xl_rows WHERE workbook = tnWB AND sheet = tnSheet AND row = tnRow INTO ARRAY laRowRecord
INSERT INTO xl_rows (workbook, sheet, row, maxcol, height, rowlevel, collapsed, hidden) ;
VALUES (tnWB, tnSheet, tnRow+1, NVL(laRowRecord[1, 1], 1), NVL(laRowRecord[1, 2], -1), NVL(laRowRecord[1, 3], 0), NVL(laRowRecord[1, 4], False), 0)
llReturn = True
OTHERWISE
llReturn = False
ENDCASE
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROTECTED PROCEDURE IsArray && Determines if the parameter passed is an array
LPARAMETERS taArray
LOCAL llIsArray, loException
IF PCOUNT() = 0
RETURN .F.
ENDIF
TRY
IF ALEN(taArray, 1) > 0
llIsArray = .T.
ELSE
llIsArray = .F.
ENDIF
CATCH TO loException
llIsArray = .F.
ENDTRY
RETURN llIsArray
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 = IIF(xl_cells.datatype = DATA_TYPE_FORMULA, True, False)
ENDIF
RETURN llFormula
ENDPROC
PROTECTED PROCEDURE IsCellReferenceInvalid && Checks if the cell reference is invalid (outside of limits)
LPARAMETERS tnCellRow, tnCellCol
IF tnCellRow <= 0 .OR. tnCellCol <= 0
RETURN True
ENDIF
IF tnCellRow > LIMITS_MAX_ROWS .OR. tnCellCol > 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
PROTECTED PROCEDURE LoadDrawingXML && Loads the drawing.xml into memory
LPARAMETERS tcDrawing
LOCAL loDrawing, loXML, lnBeg, lcVal, lnMaxSegLen
*-* Create the drawing return object
loDrawing = CREATEOBJECT('Empty')
ADDPROPERTY(loDrawing, "absoluteAnchor", CREATEOBJECT('Empty'))
ADDPROPERTY(loDrawing.absoluteAnchor, "Count", 0)
ADDPROPERTY(loDrawing.absoluteAnchor, "List[1]")
ADDPROPERTY(loDrawing, "oneCellAnchor", CREATEOBJECT('Empty'))
ADDPROPERTY(loDrawing.oneCellAnchor, "Count", 0)
ADDPROPERTY(loDrawing.oneCellAnchor, "List[1]")
ADDPROPERTY(loDrawing, "twoCellAnchor", CREATEOBJECT('Empty'))
ADDPROPERTY(loDrawing.twoCellAnchor, "Count", 0)
ADDPROPERTY(loDrawing.twoCellAnchor, "List[1]")
*-* Create XML in memory
loXML = this.AddStringToHeap(tcDrawing)
*-* Process the xml
lnMaxSegLen = 19 && Maximum length of the segment name to process + 1 character
lnBeg = 1
DO WHILE lnBeg < loXML.Length
lcVal = SYS(2600, loXML.BaseAdr-1 + lnBeg, lnMaxSegLen)
DO CASE
CASE LEFT(lcVal, 18) == "xdr:absoluteAnchor"
loSegment = this.GetXMLSegmentEx(loXML, lcVal, "", lnBeg)
loDrawing.absoluteAnchor.Count = loDrawing.absoluteAnchor.Count + 1
DIMENSION loDrawing.absoluteAnchor.List[loDrawing.absoluteAnchor.Count]
loDrawing.absoluteAnchor.List[loDrawing.absoluteAnchor.Count] = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 17) == "xdr:oneCellAnchor"
loSegment = this.GetXMLSegmentEx(loXML, lcVal, "", lnBeg)
loDrawing.oneCellAnchor.Count = loDrawing.oneCellAnchor.Count + 1
DIMENSION loDrawing.oneCellAnchor.List[loDrawing.oneCellAnchor.Count]
loDrawing.oneCellAnchor.List[loDrawing.oneCellAnchor.Count] = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 17) == "xdr:twoCellAnchor"
loSegment = this.GetXMLSegmentEx(loXML, lcVal, "", lnBeg)
loDrawing.twoCellAnchor.Count = loDrawing.twoCellAnchor.Count + 1
DIMENSION loDrawing.twoCellAnchor.List[loDrawing.twoCellAnchor.Count]
loDrawing.twoCellAnchor.List[loDrawing.twoCellAnchor.Count] = loSegment.Segment
lnBeg = loSegment.End
ENDCASE
lnBeg = lnBeg + 1
ENDDO
this.ReleaseStringFromHeap(loXML)
RETURN loDrawing
ENDPROC
PROTECTED PROCEDURE LoadSheetXml && Loads the sheet.xml into memory variable
LPARAMETERS tcSheet
*-* Create the return sheet object
LOCAL loSheet, loXML, lnBeg, lcVal, loSegment, lnMaxSegLen, lnLen
loSheet = CREATEOBJECT('Empty')
ADDPROPERTY(loSheet, "sheetViews", "")
ADDPROPERTY(loSheet, "sheetPr", "")
ADDPROPERTY(loSheet, "pageMargins", "")
ADDPROPERTY(loSheet, "printOptions", "")
ADDPROPERTY(loSheet, "pageSetup", "")
ADDPROPERTY(loSheet, "sheetProtection", "")
ADDPROPERTY(loSheet, "cols", "")
ADDPROPERTY(loSheet, "mergeCells", "")
ADDPROPERTY(loSheet, "sheetData", "")
ADDPROPERTY(loSheet, "dataValidations", "")
ADDPROPERTY(loSheet, "hyperlinks", "")
ADDPROPERTY(loSheet, "legacyDrawing", "")
ADDPROPERTY(loSheet, "drawing", "")
*-* Create XML in memory
loXML = this.AddStringToHeap(tcSheet)
*-* Process the xml
lnMaxSegLen = 17 && Maximum length of the segment name to process + 1 character
lnBeg = 1
DO WHILE lnBeg < loXML.Length
lcVal = SYS(2600, loXML.BaseAdr-1 + lnBeg, lnMaxSegLen)
DO CASE
CASE LEFT(lcVal, 13) == "", lnBeg)
loSheet.printOptions = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 8) == "", lnBeg)
loSheet.sheetPr = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 11) == "", lnBeg)
loSheet.sheetViews = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 12) == "", lnBeg)
loSheet.pageMargins = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 10) == "", lnBeg)
loSheet.pageSetup = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 16) == "", lnBeg)
loSheet.sheetProtection = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 5) == "", lnBeg)
loSheet.cols = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 11) == "", lnBeg)
loSheet.mergeCells = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 10) == "", lnBeg)
loSheet.sheetData = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 16) == "", lnBeg)
loSheet.dataValidations = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 11) == "", lnBeg)
loSheet.hyperlinks = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 14) == "", lnBeg)
loSheet.legacyDrawing = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 8) == "", lnBeg)
loSheet.drawing = loSegment.Segment
lnBeg = loSegment.End
ENDCASE
lnBeg = lnBeg + 1
ENDDO
this.ReleaseStringFromHeap(loXML)
RETURN loSheet
ENDPROC
PROTECTED PROCEDURE LoadStylesXml && Loads the styles.xml into memory
LPARAMETERS tcStyleSheet
LOCAL loStyles, loXML, lnBeg, lcVal, lnMaxSegLen
*-* Create the styles return object
loStyles = CREATEOBJECT('Empty')
ADDPROPERTY(loStyles, "cellXfs", "")
ADDPROPERTY(loStyles, "numFmts", "")
ADDPROPERTY(loStyles, "fonts", "")
ADDPROPERTY(loStyles, "fills", "")
ADDPROPERTY(loStyles, "borders", "")
ADDPROPERTY(loStyles, "colors", "")
*-* Create XML in memory
loXML = this.AddStringToHeap(tcStyleSheet)
*-* Process the xml
lnMaxSegLen = 9 && Maximum length of the segment name to process + 1 character
lnBeg = 1
DO WHILE lnBeg < loXML.Length
lcVal = SYS(2600, loXML.BaseAdr-1 + lnBeg, lnMaxSegLen)
DO CASE
CASE LEFT(lcVal, 8) == "", lnBeg)
loStyles.cellXfs = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 8) == "", lnBeg)
loStyles.numFmts = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 6) == "", lnBeg)
loStyles.fonts = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 6) == "", lnBeg)
loStyles.fills = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 8) == "", lnBeg)
loStyles.borders = loSegment.Segment
lnBeg = loSegment.End
CASE LEFT(lcVal, 7) == "", lnBeg)
loStyles.colors = loSegment.Segment
lnBeg = loSegment.End
ENDCASE
lnBeg = lnBeg + 1
ENDDO
this.ReleaseStringFromHeap(loXML)
RETURN loStyles
ENDPROC
PROCEDURE MergeCells && Merges cells together
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol
LOCAL lnRow, lnCol, lcCellValue, lnStringIndex, lcDataType, lcCellFormula, llReturn, lnFormulaSi, lcFormulaType
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
lcFormulaType = xl_cells.formulatype
lnFormulaSi = xl_cells.formulasi
lnStringIndex = xl_cells.stringid
ENDIF
REPLACE xl_cells.cellvalue 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.stringid WITH lnStringIndex, ;
xl_cells.datatype WITH lcDataType, ;
xl_cells.formulatype WITH lcFormulaType, ;
xl_cells.formulasi WITH lnFormulaSi, ;
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 OpenXlsxFileAsZip && Opens the xlsx file and extracts the xml files to a temporary folder [override this method for an alternate way to extract the files to the folder]
LPARAMETERS tcFileName, tcTempPath
LOCAL lcZipName, loShell, lnCnt, lnCntTot, loException, llFileOpen
TRY
lcZipName = ADDBS(SYS(2023)) + SYS(2015) + ".zip"
COPY FILE (tcFileName) TO (lcZipName)
MKDIR (tcTempPath)
loShell = CREATEOBJECT("shell.application")
loShell.NameSpace(tcTempPath).CopyHere(loShell.NameSpace(lcZipName).Items, FOF_SILENT)
lnCnt = 0
lnCntTot = loShell.NameSpace(lcZipName).Items.Count
DO WHILE loShell.NameSpace(tcTempPath).Items.Count != lnCntTot
lnCnt = lnCnt + 1
apiSleep(100)
IF lnCnt > lnCntTot
SET STEP ON
ENDIF
ENDDO
ERASE (lcZipName)
llFileOpen = True
CATCH TO loException
SET STEP ON
this.ErrorLevelId = 2
RAISEEVENT(this, "OnShowErrorMessage", 2, loException.Message)
llFileOpen = False
ENDTRY
RETURN llFileOpen
ENDPROC
PROCEDURE OpenXlsxWorkbook && Opens the passed Xlsx workbook and loads the internal cursors with the content
LPARAMETERS tcFileName, tlForceTextFormat, tlReadGraphicData
LOCAL lnWB, lcTempPath, lcRelations, lnNode, lcTgtFile, lnTgtSheet, lcTgtSheet, loRange, lcContType, lcFileRelsCnt, lnShId, llFileOpen
LOCAL lnRelId, lcRelType, lcTarget, lcWbXmlPath, lcRelation, lcWorkbook, lcSheet, lcShName, lcFileContent, loRelations, lcRelId, loWBSheets
LOCAL loException, loFS, lcDefinedNames, lcDefinedName, lcRName, lcComment, lnRangeId, lcRange, lnNdx, lnShState, lcFileExt, lcRelationships, lcShState
LOCAL lcCellRange, loDir, lnLastRelId, lcWBSheets, lcContentTypes, lcContentType, lcTmpSheet, llStringsXMLAdded, llStringsXMLRels
LOCAL llAdded, lcFileName
LOCAL ARRAY laTemp[1]
llStringsXMLAdded = False
llStringsXMLRels = False
DO CASE
CASE PCOUNT() = 0
this.ErrorLevelId = 1
RAISEEVENT(this, "OnShowErrorMessage", 1, "Invalid call to OpenXlsxWorkbook() method; must include file name to open")
RETURN 0
CASE PCOUNT() = 1
tlForceTextFormat = False
tlReadGraphicData = True
CASE PCOUNT() = 2
tlReadGraphicData = True
ENDCASE
lnWB = 0
IF ADIR(laTemp, tcFileName) > 0
*-* Open the Workbook as an archive (zip) file and extract contents
lcTempPath = ADDBS(SYS(2023)) + SYS(2015)
llFileOpen = this.OpenXlsxFileAsZip(tcFileName, lcTempPath)
IF !llFileOpen
RETURN 0
ENDIF
*-* Save system settings
this.SaveVFPSettings()
*-* Add to the workbook table
lnWB = this.CreateWorkbookEx(tcFileName)
IF lnWB > 0
*-* Verify all required XML files are present
lcWbXmlPath = IIF(RIGHT(lcTempPath, 1) = "\", LEFT(lcTempPath, LEN(lcTempPath)-1), 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)
this.RestoreVFPSettings()
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)
this.RestoreVFPSettings()
RETURN 0
ENDIF
*-* Process the workbook
RAISEEVENT(this, "OnShowStatusMessage", 1, 1, 6)
TRY
*-* Get the default content types
lcContentTypes = FILETOSTR(lcWbXmlPath + "\[Content_Types].xml")
lnNode = 1
lcContentType = this.GetNodeElement(lcContentTypes, 'Default', lnNode)
DO WHILE !EMPTY(lcContentType)
lcFileExt = this.GetNodeAttributeValue(lcContentType, "Extension")
lcContType = this.GetNodeAttributeValue(lcContentType, "ContentType")
IF tlReadGraphicData
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (lnWB, lcFileExt, lcContType)
ELSE
IF lcContType != "image"
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (lnWB, lcFileExt, lcContType)
ENDIF
ENDIF
*-* Check if this is a macro enabled workbook
IF RIGHT(lcContType, 10) = "vbaProject"
UPDATE xl_workbooks SET macroenabled = True WHERE workbook = lnWB
EXIT
ENDIF
lnNode = lnNode + 1
lcContentType = this.GetNodeElement(lcContentTypes, 'Default', lnNode)
ENDDO
*-* Set base path to workbook files
lcWbXmlPath = lcWbXmlPath + "\xl\"
*-* Load the workbook files into memory for processing
lcWorkbook = FILETOSTR(lcWbXmlPath + "workbook.xml")
lcWBSheets = this.GetNodeElement(lcWorkbook, 'sheets', 1, False, 1)
loWBSheets = this.AddStringToHeap(lcWBSheets)
*-* Get the defined relationship files for this workbook; process each file
RAISEEVENT(this, "OnShowStatusMessage", 1, 3)
lnLastRelId = 0
lcRelations = FILETOSTR(lcWbXmlPath + "_rels\workbook.xml.rels")
loRelations = this.AddStringToHeap(lcRelations)
lcRelation = this.GetXMLFirstSegment(loRelations, 'Relationship')
DO WHILE !EMPTY(lcRelation)
lcRelId = this.GetNodeAttributeValue(lcRelation, "Id")
lnRelId = CAST(SUBSTR(lcRelId, 4) AS I)
lcTarget = this.GetNodeAttributeValue(lcRelation, "Target")
lcRelType = this.GetNodeAttributeValue(lcRelation, "Type")
lcRelType = SUBSTR(lcRelType, RATC("/", lcRelType)+1)
lcFileName = lcWbXmlPath + lcTarget
IF ADIR(laTemp, lcFileName) > 0
DO CASE
CASE lcRelType = "calcChain"
*-* Not supported; this is dependent on the order the cells were last calculated by program version
CASE lcRelType = "externalLink"
lcFileContent = this.ConvertFileToString(lcFileName, 13)
lcFileRelsCnt = this.ConvertFileToString(lcWbXmlPath + ADDBS(JUSTPATH(lcTarget)) + "_rels\" + JUSTSTEM(lcTarget) + ".xml.rels", 13)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, filecontent, relscontent) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_EXTNLINK, lcTarget, lcFileContent, lcFileRelsCnt)
CASE lcRelType = "sharedStrings"
IF !this.ReadSharedStringsXML(lcFileName, lnWB)
this.ErrorLevelId = 7
RAISEEVENT(this, "OnShowErrorMessage", 7, "Invalid XLSX file - error during shared string loading")
THROW
ENDIF
llStringsXMLRels = True
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_SHAREDSTRINGS, lcTarget)
CASE lcRelType = "styles"
this.ReadStylesXML(lcFileName, lnWB)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_STYLES, lcTarget)
CASE lcRelType = "theme"
lcFileContent = FILETOSTR(lcFileName)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, filecontent) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_THEME, lcTarget, lcFileContent)
CASE lcRelType = "vbaProject"
lcFileContent = this.ConvertFileToString(lcFileName, 13)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, filecontent) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_VBAPROJECT, lcTarget, lcFileContent)
CASE lcRelType = "worksheet"
lcSheet = ""
lcTmpSheet = this.GetXMLFirstSegment(loWBSheets, 'sheet')
DO WHILE !EMPTY(lcTmpSheet)
IF ATC(lcRelId, lcTmpSheet) > 0
lcSheet = lcTmpSheet
EXIT
ENDIF
lcTmpSheet = this.GetXMLNextSegment(loWBSheets)
ENDDO
IF EMPTY(lcSheet)
SET STEP ON
this.ErrorLevelId = 8
RAISEEVENT(this, "OnShowErrorMessage", 8, "Invalid XLSX file - missing sheet or invalid sheet: " + lcTarget)
this.DeleteWorkbook(lnWB)
THROW
ENDIF
lnShId = CAST(CHRTRAN(lcTarget, CHRTRAN(lcTarget, '1234567890', ''), '') AS I)
lcShName = this.GetStringXML(this.GetNodeAttributeValue(lcSheet, "name"))
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
llAdded = this.ReadSheetXML(lcFileName, lnWB, lnShId, lcShName, lnShState, tlForceTextFormat, tlReadGraphicData)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (lnWB, lnShId, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_WORKSHEET, lcTarget)
this.SetLastId(lnWB, 0, lnShId, "xl_sheets")
IF llAdded .AND. !llStringsXMLAdded
llStringsXMLAdded = llAdded
ENDIF
OTHERWISE
SET STEP ON
* lcRelType = this.GetNodeAttributeValue(lcRelation, "Type")
* lcFileContent = this.ConvertFileToString(lcFileName, 13)
* lcFileRelsCnt = this.ConvertFileToString(lcWbXmlPath + ADDBS(JUSTPATH(lcTarget)) + "_rels\" + JUSTSTEM(lcTarget) + ".xml.rels", 13)
* INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, reltypeunk, target, filecontent, relscontent) ;
* VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_UNKNOWN, lcRelType, lcTarget, lcFileContent, lcFileRelsCnt)
ENDCASE
ENDIF
IF lnRelId > lnLastRelId
lnLastRelId = lnRelId
ENDIF
lcRelation = this.GetXMLNextSegment(loRelations)
ENDDO
this.ReleaseStringFromHeap(loWBSheets)
this.ReleaseStringFromHeap(loRelations)
*-* Check if a cell with an inline string value was added without the relationship file strings.xml
IF llStringsXMLAdded .AND. !llStringsXMLRels
lnLastRelId = lnLastRelId + 1
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnLastRelId, RELS_TYPE_SHAREDSTRINGS, "sharedStrings.xml")
ENDIF
*-* Save the last used relationship id
this.SetLastId(lnWB, 0, lnLastRelId, "xl_workbook_rels")
*-* Check if any referenced sheet name was not matched to the sheet index during read for hyperlinks
SELECT xl_hyperlinks
SCAN FOR tgtsheet = 0
lnTgtSheet = this.GetSheetIndex(lnWB, ALLTRIM(xl_hyperlinks.tgtsheetname))
REPLACE xl_hyperlinks.tgtsheet WITH lnTgtSheet IN xl_hyperlinks
ENDSCAN
*-* 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)
loRange = this.ConvertRangeToColumnRowValues(lcCellRange)
INSERT INTO xl_namerange (workbook, sheet, rname, scope, comment, begrow, begcol, endrow, endcol) ;
VALUES (lnWB, xl_sheets.sheet, lcRName, lnRangeId, lcComment, loRange.BegRow, loRange.BegCol, loRange.EndRow, loRange.EndCol)
ENDIF
ENDIF
ENDIF
lnNode = lnNode + 1
lcDefinedName = this.GetNodeElement(lcDefinedNames, 'definedName', lnNode)
ENDDO
ENDIF
RAISEEVENT(this, "OnShowStatusMessage", 1, 6)
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
ENDIF
this.RestoreVFPSettings()
ENDIF
RETURN lnWB
ENDPROC
PROCEDURE OpenXlsxWorkbookSheet && Opens a selected worksheet in a XLXS workbook
LPARAMETERS tcFileName, txSheet, tlForceTextFormat, tlReadGraphicData
LOCAL lnWB, lcTempPath, lcRelations, lnNode, lcTgtFile, lnTgtSheet, lcTgtSheet, loRange, lcContType, lcFileRelsCnt, lnShId, llFileOpen
LOCAL lnRelId, lcRelType, lcTarget, lcWbXmlPath, lcRelation, lcWorkbook, lcSheet, lcShName, lcFileContent, loRelations, lcRelId, loWBSheets, lnSec
LOCAL loException, loFS, lcDefinedNames, lcDefinedName, lcRName, lcComment, lnRangeId, lcRange, lnNdx, lnShState, lcFileExt, lcRelationships, lcShState
LOCAL lcCellRange, loDir, lnLastRelId, lcWBSheets, lcContTypes, lcDefType, llProcessSheet, lcTmpSheet
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 and sheet")
RETURN 0
CASE PCOUNT() = 1
this.ErrorLevelId = 1
RAISEEVENT(this, "OnShowErrorMessage", 1, "Invalid call to OpenXlsxWorkbook() method; must include sheet to process")
RETURN 0
CASE PCOUNT() = 2
tlForceTextFormat = False
tlReadGraphicData = True
CASE PCOUNT() = 3
tlReadGraphicData = True
ENDCASE
lnWB = 0
IF ADIR(laTemp, tcFileName) > 0
*-* Open the Workbook as an archive (zip) file and extract contents
lcTempPath = ADDBS(SYS(2023)) + SYS(2015)
llFileOpen = this.OpenXlsxFileAsZip(tcFileName, lcTempPath)
IF !llFileOpen
RETURN 0
ENDIF
*-* Save system settings
this.SaveVFPSettings()
*-* Add to the workbook table
lnWB = this.CreateWorkbookEx(tcFileName)
IF lnWB > 0
*-* Verify all required XML files are present
lcWbXmlPath = IIF(RIGHT(lcTempPath, 1) = "\", LEFT(lcTempPath, LEN(lcTempPath)-1), 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)
this.RestoreVFPSettings()
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)
this.RestoreVFPSettings()
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)
this.RestoreVFPSettings()
RETURN 0
ENDIF
*-* Process the workbook
RAISEEVENT(this, "OnShowStatusMessage", 1, 1, 6)
TRY
*-* Get the default content types
lcContTypes = FILETOSTR(lcWbXmlPath + "\[Content_Types].xml")
lnNode = 1
lcDefType = this.GetNodeElement(lcContTypes, 'Default', lnNode)
DO WHILE !EMPTY(lcDefType)
lcFileExt = this.GetNodeAttributeValue(lcDefType, "Extension")
lcContType = this.GetNodeAttributeValue(lcDefType, "ContentType")
IF tlReadGraphicData
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (lnWB, lcFileExt, lcContType)
ELSE
IF lcContType != "image"
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (lnWB, lcFileExt, lcContType)
ENDIF
ENDIF
lnNode = lnNode + 1
lcDefType = this.GetNodeElement(lcContTypes, 'Default', lnNode)
ENDDO
*-* Set base path to workbook files
lcWbXmlPath = lcWbXmlPath + "\xl\"
*-* Load the workbook files into memory for processing
lcWorkbook = FILETOSTR(lcWbXmlPath + "workbook.xml")
lcWBSheets = this.GetNodeElement(lcWorkbook, 'sheets', 1, False, 1)
loWBSheets = this.AddStringToHeap(lcWBSheets)
*-* Get the workbook settings in the workbook.xml file
*-* Currently not adding calc chain to workbook for restoring; has problems if sheet ids change or sheets removed/added
* lcCalcPr = this.GetNodeElement(lcWorkbook, 'calcPr', 1, False, 1)
* lnCalcPr = CAST(this.GetNodeAttributeValue(lcCalcPr, "calcId") AS I)
* IF lnCalcPr > 0
* UPDATE xl_workbooks SET calcid = lnCalcPr WHERE workbook = lnWB
* ENDIF
*-* Get the defined relationship files for this workbook; process each file
RAISEEVENT(this, "OnShowStatusMessage", 1, 3)
lcRelations = FILETOSTR(lcWbXmlPath + "_rels\workbook.xml.rels")
loRelations = this.AddStringToHeap(lcRelations)
lcRelation = this.GetXMLFirstSegment(loRelations, 'Relationship')
lnLastRelId = 0
DO WHILE !EMPTY(lcRelation)
lcRelId = this.GetNodeAttributeValue(lcRelation, "Id")
lnRelId = CAST(SUBSTR(lcRelId, 4) AS I)
lcTarget = this.GetNodeAttributeValue(lcRelation, "Target")
lcRelType = this.GetNodeAttributeValue(lcRelation, "Type")
lcRelType = SUBSTR(lcRelType, RATC("/", lcRelType)+1)
DO CASE
CASE lcRelType = "calcChain"
* lcFileContent = FILETOSTR(lcWbXmlPath + lcTarget)
* INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, filecontent) ;
* VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_CALCCHAIN, lcTarget, lcFileContent)
CASE lcRelType = "externalLink"
lcFileContent = this.ConvertFileToString(lcWbXmlPath + lcTarget, 13)
lcFileRelsCnt = this.ConvertFileToString(lcWbXmlPath + ADDBS(JUSTPATH(lcTarget)) + "_rels\" + JUSTSTEM(lcTarget) + ".xml.rels", 13)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, filecontent, relscontent) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_EXTNLINK, lcTarget, lcFileContent, lcFileRelsCnt)
CASE lcRelType = "sharedStrings"
lnSec = SECONDS()
IF !this.ReadSharedStringsXML(lcWbXmlPath + lcTarget, lnWB)
this.ErrorLevelId = 7
RAISEEVENT(this, "OnShowErrorMessage", 7, "Invalid XLSX file - error during shared string loading")
THROW
ENDIF
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_SHAREDSTRINGS, lcTarget)
*-* IF this.Debug
*-* ? "Read sharedStrings: " + TRANSFORM(SECONDS() - lnSec)
*-* ENDIF
CASE lcRelType = "styles"
lnSec = SECONDS()
this.ReadStylesXML(lcWbXmlPath + lcTarget, lnWB)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_STYLES, lcTarget)
*-* IF this.Debug
*-* ? "Read styles: " + TRANSFORM(SECONDS() - lnSec)
*-* ENDIF
CASE lcRelType = "theme"
lcFileContent = FILETOSTR(lcWbXmlPath + lcTarget)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, filecontent) ;
VALUES (lnWB, 0, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_THEME, lcTarget, lcFileContent)
CASE lcRelType = "worksheet"
lnSec = SECONDS()
lcSheet = ""
lcTmpSheet = this.GetXMLFirstSegment(loWBSheets, 'sheet')
DO WHILE !EMPTY(lcTmpSheet)
IF ATC(lcRelId, lcTmpSheet) > 0
lcSheet = lcTmpSheet
EXIT
ENDIF
lcTmpSheet = this.GetXMLNextSegment(loWBSheets)
ENDDO
IF EMPTY(lcSheet)
SET STEP ON
this.ErrorLevelId = 8
RAISEEVENT(this, "OnShowErrorMessage", 8, "Invalid XLSX file - missing sheet or invalid sheet: " + lcTarget)
this.DeleteWorkbook(lnWB)
THROW
ENDIF
lnShId = CAST(CHRTRAN(lcTarget, CHRTRAN(lcTarget, '1234567890', ''), '') AS I)
lcShName = this.GetNodeAttributeValue(lcSheet, "name")
DO CASE
CASE VARTYPE(txSheet) = "C"
IF UPPER(lcShName) == UPPER(txSheet)
llProcessSheet = True
ELSE
llProcessSheet = False
ENDIF
CASE VARTYPE(txSheet) = "N"
IF lnShId = txSheet
llProcessSheet = True
ELSE
llProcessSheet = False
ENDIF
OTHERWISE
ENDCASE
IF llProcessSheet
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
this.ReadSheetXML(lcWbXmlPath + lcTarget, lnWB, 1, lcShName, lnShState, tlForceTextFormat, tlReadGraphicData)
lcTarget = CHRTRAN(lcTarget, '1234567890', '')
lcTarget = STUFF(lcTarget, ATC('.', lcTarget), 0, '1')
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target) ;
VALUES (lnWB, 1, RELS_SRC_WORKBOOK, lnRelId, RELS_TYPE_WORKSHEET, lcTarget)
this.SetLastId(lnWB, 0, 1, "xl_sheets")
*-* IF this.Debug
*-* ? "Read worksheet" + TRANSFORM(lnShId) + ": " + TRANSFORM(SECONDS() - lnSec)
*-* ENDIF
ENDIF
OTHERWISE
SET STEP ON
ENDCASE
IF lnRelId > lnLastRelId
lnLastRelId = lnRelId
ENDIF
lcRelation = this.GetXMLNextSegment(loRelations)
ENDDO
this.ReleaseStringFromHeap(loWBSheets)
this.ReleaseStringFromHeap(loRelations)
this.SetLastId(lnWB, 0, lnLastRelId, "xl_workbook_rels")
*-* Check if any referenced sheet name was not matched to the sheet index during read for hyperlinks
SELECT xl_hyperlinks
SCAN FOR tgtsheet = 0
lnTgtSheet = this.GetSheetIndex(lnWB, ALLTRIM(xl_hyperlinks.tgtsheetname))
REPLACE xl_hyperlinks.tgtsheet WITH lnTgtSheet IN xl_hyperlinks
ENDSCAN
*-* 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)
loRange = this.ConvertRangeToColumnRowValues(lcCellRange)
INSERT INTO xl_namerange (workbook, sheet, rname, scope, comment, begrow, begcol, endrow, endcol) ;
VALUES (lnWB, xl_sheets.sheet, lcRName, lnRangeId, lcComment, loRange.BegRow, loRange.BegCol, loRange.EndRow, loRange.EndCol)
ENDIF
ENDIF
ENDIF
lnNode = lnNode + 1
lcDefinedName = this.GetNodeElement(lcDefinedNames, 'definedName', lnNode)
ENDDO
ENDIF
RAISEEVENT(this, "OnShowStatusMessage", 1, 6)
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
ENDIF
this.RestoreVFPSettings()
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, tnSheet, tcColumn, tnCellRow, tnCellCol
LOCAL lcCellType, lnNode, lcBaseName, lcFormatCode, lnNdx, loCell, lcWholeNbr, lcDecNbr
LOCAL lcPosFormat, lcNegFormat, lcZerFormat, lcInLineTxt, lcChild, lcRefBeg, lcRefEnd, lcRelative
LOCAL lcFormulaRef, lcFormula
loCell = CREATEOBJECT("Empty")
ADDPROPERTY(loCell, "CellVal", "")
ADDPROPERTY(loCell, "DataType", DATA_TYPE_NONE)
ADDPROPERTY(loCell, "StringNdx", 0)
ADDPROPERTY(loCell, "CellXfsId", 0)
ADDPROPERTY(loCell, "FormulaType", "")
ADDPROPERTY(loCell, "FormulaSi", -1)
lcCellType = this.GetNodeAttributeValue(tcColumn, "t")
IF lcCellType = "e" && Cell contains an error, do not process
loCell.CellXfsId = CAST(this.GetNodeAttributeValue(tcColumn, "s") AS I)
ELSE
*-* Check for formula expression
lcChild = this.GetNodeElement(tcColumn, "f", 1, False, 5)
IF !EMPTY(lcChild)
lcCellType = "f"
lcFormula = this.GetNodeElementValue(lcChild)
lcFormulaRef = this.GetNodeAttributeValue(lcChild, "ref")
loCell.FormulaType = this.GetNodeAttributeValue(lcChild, "t")
IF loCell.FormulaType = "shared"
loCell.FormulaSi = CAST(this.GetNodeAttributeValue(lcChild, "si") AS INTEGER)
lcRefBeg = this.GetColumnInColRowPair(GETWORDNUM(lcFormulaRef, 1, ":"))
lcRefEnd = this.GetColumnInColRowPair(GETWORDNUM(lcFormulaRef, 2, ":"))
lcRelative = IIF(lcRefBeg == lcRefEnd, SHARED_FORMULA_ROW, SHARED_FORMULA_COLUMN)
ELSE
lcRelative = ""
loCell.FormulaSi = -1
ENDIF
INSERT INTO xl_formulas (workbook, sheet, cellrow, cellcol, formulatype, si, ref, formrel, cellformula) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, loCell.FormulaType, loCell.FormulaSi, lcFormulaRef, lcRelative, lcFormula)
ENDIF
*-* Check for value assigned to cell
lcChild = this.GetNodeElement(tcColumn, "v" , 1, False, 5)
IF !EMPTY(lcChild)
loCell.CellVal = this.GetNodeElementValue(lcChild)
ENDIF
*-* Check for inline text assigned to cell
lcChild = this.GetNodeElement(tcColumn, "is", 1, False, 5)
IF !EMPTY(lcChild)
lcInLineTxt = this.GetNodeElement(lcChild, 't', 1)
loCell.CellVal = this.GetNodeElementValue(lcInLineTxt)
ENDIF
loCell.CellXfsId = CAST(this.GetNodeAttributeValue(tcColumn, "s") AS I)
DO CASE
CASE lcCellType == "f"
loCell.DataType = DATA_TYPE_FORMULA
CASE lcCellType == "s" .OR. lcCellType == "str"
loCell.StringNdx = CAST(loCell.CellVal AS I)
loCell.CellVal = "StringValue"
loCell.DataType = DATA_TYPE_CHAR
CASE lcCellType == "inlineStr"
loCell.CellVal = this.GetStringXML(loCell.CellVal)
loCell.StringNdx = this.AddStringValue(tnWB, loCell.CellVal, False)
loCell.CellVal = "StringValue"
loCell.DataType = DATA_TYPE_CHAR
CASE EMPTY(loCell.CellVal)
RETURN loCell
OTHERWISE
*-* Determine the data type of the value based on assigned format
IF SEEK(BINTOC(tnWB)+BINTOC(loCell.CellXfsId), "xl_cellxfs", "id")
DO CASE
CASE INLIST(xl_cellxfs.numFmtId, 1, 3, 37, 38) && Integer format
loCell.DataType = DATA_TYPE_INT
CASE INLIST(xl_cellxfs.numFmtId, 2, 4, 7, 8, 11, 12, 13, 39, 40) && Float format
loCell.DataType = DATA_TYPE_FLOAT
CASE INLIST(xl_cellxfs.numFmtId, 9, 10) && Numeric percent format
loCell.DataType = DATA_TYPE_FLOAT
CASE INLIST(xl_cellxfs.numFmtId, 14, 15, 16, 17) && Date format
DO CASE
CASE ATC(".", loCell.CellVal) = 0 .OR. RIGHT(loCell.CellVal, 1) = "."
loCell.DataType = DATA_TYPE_DATE
CASE ATC(".", loCell.CellVal) > 0
lnNdx = ATC(".", loCell.CellVal)
lcWholeNbr = LEFT(loCell.CellVal, lnNdx-1)
lcDecNbr = SUBSTR(loCell.CellVal, lnNdx+1)
IF LEN(lcDecNbr) > 0
loCell.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCell.DataType = DATA_TYPE_DATETIME
ELSE
loCell.CellVal = lcWholeNbr
loCell.DataType = DATA_TYPE_DATE
ENDIF
ENDCASE
CASE INLIST(xl_cellxfs.numFmtId, 18, 19, 20, 21, 45, 46) && Time format
DO CASE
CASE ATC("E-", loCell.CellVal) > 0
loCell.CellVal = PADR(TRANSFORM(EVAL(loCell.CellVal)), 19, "0")
loCell.DataType = DATA_TYPE_TIME
CASE ATC("E", loCell.CellVal) > 0
loCell.CellVal = TRANSFORM(EVAL(loCell.CellVal))
lnNdx = ATC(".", loCell.CellVal)
lcWholeNbr = LEFT(loCell.CellVal, lnNdx-1)
lcDecNbr = SUBSTR(loCell.CellVal, lnNdx+1)
loCell.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCell.DataType = DATA_TYPE_DATETIME
CASE LEFT(loCell.CellVal, 2) = "0."
lcDecNbr = SUBSTR(loCell.CellVal, 3)
loCell.CellVal = "0." + PADR(lcDecNbr, 17, "0")
loCell.DataType = DATA_TYPE_TIME
OTHERWISE
lnNdx = ATC(".", loCell.CellVal)
lcWholeNbr = LEFT(loCell.CellVal, lnNdx-1)
lcDecNbr = SUBSTR(loCell.CellVal, lnNdx+1)
loCell.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCell.DataType = DATA_TYPE_FLOAT
ENDCASE
CASE INLIST(xl_cellxfs.numFmtId, 22, 29, 30, 31, 32, 33, 34) && Date-time format
lnNdx = ATC(".", loCell.CellVal)
lcWholeNbr = IIF(lnNdx=0, loCell.CellVal, LEFT(loCell.CellVal, lnNdx-1)) && Bug fix provide by Dan Goodwin from VFPx
lcDecNbr = IIF(lnNdx=0, "", SUBSTR(loCell.CellVal, lnNdx+1)) && Bug fix provide by Dan Goodwin from VFPx
loCell.CellVal = lcWholeNbr + "." + PADR(lcDecNbr, 17, "0")
loCell.DataType = DATA_TYPE_DATETIME
CASE xl_cellxfs.numFmtId = 49 && Numeric formatted as text
loCell.DataType = DATA_TYPE_TEXT
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
loCell.DataType = DATA_TYPE_DATETIME
CASE ATC("yy", lcFormatCode) > 0 .OR. ATC("d\-m", lcFormatCode) > 0
loCell.DataType = DATA_TYPE_DATE
OTHERWISE
lnNdx = ATC(".", lcFormatCode)
IF lnNdx > 0
loCell.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
loCell.DataType = DATA_TYPE_INT
ENDIF
ENDCASE
OTHERWISE
DO CASE
CASE ISNULL(loCell.CellVal) .OR. EMPTY(loCell.CellVal)
loCell.DataType = DATA_TYPE_NONE
CASE ATC(".", loCell.CellVal) > 0
loCell.DataType = DATA_TYPE_FLOAT
OTHERWISE
loCell.DataType = DATA_TYPE_INT
ENDCASE
ENDCASE
ELSE
DO CASE
CASE ISNULL(loCell.CellVal) .OR. EMPTY(loCell.CellVal)
loCell.CellVal = ""
loCell.DataType = DATA_TYPE_NONE
CASE ATC(".", loCell.CellVal) > 0
loCell.DataType = DATA_TYPE_FLOAT
OTHERWISE
loCell.DataType = DATA_TYPE_INT
ENDCASE
ENDIF
ENDCASE
ENDIF
RETURN loCell
ENDPROC
PROTECTED PROCEDURE ReadCommentXML && Reads the comment definitions for the sheet
LPARAMETERS tnWB, tnSheet, tcCommentFile
LOCAL lcCommentXML, loException, loXML
TRY
*-* lcCommentXML = FILETOSTR(tcCommentFile)
*-*
*-* IF EMPTY(lcCommentXML)
*-* THROW "No comment definitions in Sheet " + TRANSFORM(tnSheet)
*-* ELSE
*-* *-* Create XML in memory
*-* loXML = this.AddStringToHeap(lcCommentXML)
*-*
*-* *-* Process xdr:absoluteAnchor segments
*-* lcAbsoluteAnchor = this.GetXMLFirstSegment(loXML, 'xdr:absoluteAnchor')
*-* DO WHILE !EMPTY(lcAbsoluteAnchor)
*-*
*-*
*-* lcAbsoluteAnchor = this.GetXMLNextSegment(loXML)
*-* ENDDO
*-* this.ReleaseStringFromHeap(loXML)
*-* ENDIF
CATCH TO loException
SET STEP ON
ENDTRY
ENDPROC
PROTECTED PROCEDURE ReadDrawingXML && Reads the drawing (image) xml for associated sheet
LPARAMETERS tnWB, tnSheet, tcDwgFile, tnRelId
LOCAL lcDrawingXML, loException, lcAnchorXml, lcXdrFrom, lnBegCol, lnBegColOff, lnBegRow, lnBegRowOff
LOCAL lcXdrTo, lnEndCol, lnEndColOff, lnEndRow, lnEndRowOff, loXdrPic, lcXdrPic, lcFileExtn
LOCAL lcXdrExt, lnX, lnY, lnCX, lnCY, lcXdrSp, loDrawing
TRY
lcDrawingXML = FILETOSTR(tcDwgFile)
IF EMPTY(lcDrawingXML)
THROW "No drawing definitions in Sheet " + TRANSFORM(tnSheet)
ELSE
*-* Load the drawing.xml into memory object
loDrawing = this.LoadDrawingXml(lcDrawingXML)
*-* Get the drawing information positioned by absoluteAnchor
FOR lnNdx=1 TO loDrawing.absoluteAnchor.Count
lcAnchorXml = loDrawing.absoluteAnchor.List[lnNdx]
lcXdrExt = this.GetNodeElement(lcAnchorXml, 'xdr:ext', 1)
lnX = CAST(this.GetNodeAttributeValue(lcXdrExt, "x") AS I)
lnY = CAST(this.GetNodeAttributeValue(lcXdrExt, "y") AS I)
lcXdrExt = this.GetNodeElement(lcAnchorXml, 'xdr:ext', 2)
lnCX = CAST(this.GetNodeAttributeValue(lcXdrExt, "cx") AS I)
lnCY = CAST(this.GetNodeAttributeValue(lcXdrExt, "cy") AS I)
lcXdrPic = this.GetNodeElement(lcAnchorXml, 'xdr:pic', 1, True, 1)
IF EMPTY(lcXdrPic)
lcXdrSp = this.GetNodeElement(lcAnchorXml, 'xdr:sp', 1, True, 1)
IF !EMPTY(lcXdrSp)
*-* TODO: Not yet supported for shapes
ENDIF
ELSE
loXdrPic = this.GetDwgPicDefinition(lcXdrPic, tcDwgFile)
INSERT INTO xl_images (workbook, sheet, relid, anchor, begcol, begrow, cx, cy) ;
VALUES (tnWB, tnSheet, loXdrPic.RelId, IMAGE_ANCHOR_TYPE_ABS, lnX, lnY, lnCX, lnCY)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, EXTERNAL, globalid, filecontent) ;
VALUES (tnWB, tnSheet, RELS_SRC_DRAWING, loXdrPic.RelId, RELS_TYPE_IMAGE, JUSTFNAME(loXdrPic.ImageFile), False, loXdrPic.GblId, ;
this.ConvertFileToString(loXdrPic.ImageFile, 13))
this.SetLastId(tnWB, tnSheet, loXdrPic.RelId, "xl_drawing_rels")
IF !SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+RELS_TYPE_DRAWING, "xl_relationships", "reltype")
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, EXTERNAL) ;
VALUES (tnWB, tnSheet, RELS_SRC_SHEET, tnRelId, RELS_TYPE_DRAWING, "../drawings/drawing" + TRANSFORM(tnSheet) + ".xml", False)
this.SetLastId(tnWB, tnSheet, tnRelId, "xl_sheet_rels")
ENDIF
this.SetLastId(tnWB, tnSheet, loXdrPic.GblId, "global")
lcFileExtn = LOWER(JUSTEXT(loXdrPic.ImageFile))
IF !SEEK(BINTOC(tnWB)+lcFileExtn, "xl_contenttypes", "extension")
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (tnWB, lcFileExtn, "image/" + lcFileExtn)
ENDIF
ENDIF
ENDFOR
*-* Get the drawing information positioned by oneCellAnchor
FOR lnNdx=1 TO loDrawing.oneCellAnchor.Count
lcAnchorXml = loDrawing.oneCellAnchor.List[lnNdx]
lcXdrFrom = this.GetNodeElement(lcAnchorXml, 'xdr:from', 1, True, 1)
lnBegCol = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:col', 1, True, 1) AS I)
lnBegColOff = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:colOff', 1, True, 1) AS I)
lnBegRow = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:row', 1, True, 1) AS I)
lnBegRowOff = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:rowOff', 1, True, 1) AS I)
lcXdrPic = this.GetNodeElement(lcAnchorXml, 'xdr:pic', 1, True, 1)
IF EMPTY(lcXdrPic)
lcXdrSp = this.GetNodeElement(lcAnchorXml, 'xdr:sp', 1, True, 1)
IF !EMPTY(lcXdrSp)
*-* TODO: Not yet supported for shapes
ENDIF
ELSE
loXdrPic = this.GetDwgPicDefinition(lcXdrPic, tcDwgFile)
INSERT INTO xl_images (workbook, sheet, relid, anchor, begcol, begcoloff, begrow, begrowoff, cx, cy) ;
VALUES (tnWB, tnSheet, loXdrPic.RelId, IMAGE_ANCHOR_TYPE_ONE, lnBegCol, lnBegColOff, lnBegRow, lnBegRowOff, loXdrPic.ImgWidth, loXdrPic.ImgHeight)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, EXTERNAL, globalid, filecontent) ;
VALUES (tnWB, tnSheet, RELS_SRC_DRAWING, loXdrPic.RelId, RELS_TYPE_IMAGE, JUSTFNAME(loXdrPic.ImageFile), False, loXdrPic.GblId, ;
this.ConvertFileToString(loXdrPic.ImageFile, 13))
this.SetLastId(tnWB, tnSheet, loXdrPic.RelId, "xl_drawing_rels")
IF !SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+RELS_TYPE_DRAWING, "xl_relationships", "reltype")
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, EXTERNAL) ;
VALUES (tnWB, tnSheet, RELS_SRC_SHEET, tnRelId, RELS_TYPE_DRAWING, "../drawings/drawing" + TRANSFORM(tnSheet) + ".xml", False)
this.SetLastId(tnWB, tnSheet, tnRelId, "xl_sheet_rels")
ENDIF
this.SetLastId(tnWB, tnSheet, loXdrPic.GblId, "global")
lcFileExtn = LOWER(JUSTEXT(loXdrPic.ImageFile))
IF !SEEK(BINTOC(tnWB)+lcFileExtn, "xl_contenttypes", "extension")
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (tnWB, lcFileExtn, "image/" + lcFileExtn)
ENDIF
ENDIF
ENDFOR
*-* Get the drawing information positioned by twoCellAnchor
FOR lnNdx=1 TO loDrawing.twoCellAnchor.Count
lcAnchorXml = loDrawing.twoCellAnchor.List[lnNdx]
lcXdrFrom = this.GetNodeElement(lcAnchorXml, 'xdr:from', 1, True, 1)
lnBegCol = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:col', 1, True, 1) AS I)
lnBegColOff = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:colOff', 1, True, 1) AS I)
lnBegRow = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:row', 1, True, 1) AS I)
lnBegRowOff = CAST(this.GetNodeElement(lcXdrFrom, 'xdr:rowOff', 1, True, 1) AS I)
lcXdrTo = this.GetNodeElement(lcAnchorXml, 'xdr:to', 1, True)
lnEndCol = CAST(this.GetNodeElement(lcXdrTo, 'xdr:col', 1, True, 1) AS I)
lnEndColOff = CAST(this.GetNodeElement(lcXdrTo, 'xdr:colOff', 1, True, 1) AS I)
lnEndRow = CAST(this.GetNodeElement(lcXdrTo, 'xdr:row', 1, True, 1) AS I)
lnEndRowOff = CAST(this.GetNodeElement(lcXdrTo, 'xdr:rowOff', 1, True, 1) AS I)
lcXdrPic = this.GetNodeElement(lcAnchorXml, 'xdr:pic', 1, True, 1)
IF EMPTY(lcXdrPic)
lcXdrSp = this.GetNodeElement(lcAnchorXml, 'xdr:sp', 1, True, 1)
IF !EMPTY(lcXdrSp)
*-* TODO: Not yet supported for shapes
ENDIF
ELSE
lcEditAs = this.GetNodeAttributeValue(lcAnchorXml, "editAs")
loXdrPic = this.GetDwgPicDefinition(lcXdrPic, tcDwgFile)
INSERT INTO xl_images (workbook, sheet, relid, anchor, imgmove, begcol, begcoloff, begrow, begrowoff, endcol, endcoloff, endrow, endrowoff, cx, cy) ;
VALUES (tnWB, tnSheet, loXdrPic.RelId, IMAGE_ANCHOR_TYPE_TWO, lcEditAs, lnBegCol, lnBegColOff, lnBegRow, lnBegRowOff, lnEndCol, lnEndColOff, ;
lnEndRow, lnEndRowOff, loXdrPic.ImgWidth, loXdrPic.ImgHeight)
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, EXTERNAL, globalid, filecontent) ;
VALUES (tnWB, tnSheet, RELS_SRC_DRAWING, loXdrPic.RelId, RELS_TYPE_IMAGE, JUSTFNAME(loXdrPic.ImageFile), False, loXdrPic.GblId, ;
this.ConvertFileToString(loXdrPic.ImageFile, 13))
this.SetLastId(tnWB, tnSheet, loXdrPic.RelId, "xl_drawing_rels")
IF !SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+RELS_TYPE_DRAWING, "xl_relationships", "reltype")
INSERT INTO xl_relationships (workbook, sheet, relsrc, relid, reltype, target, EXTERNAL) ;
VALUES (tnWB, tnSheet, RELS_SRC_SHEET, tnRelId, RELS_TYPE_DRAWING, "../drawings/drawing" + TRANSFORM(tnSheet) + ".xml", False)
this.SetLastId(tnWB, tnSheet, tnRelId, "xl_sheet_rels")
ENDIF
this.SetLastId(tnWB, tnSheet, loXdrPic.GblId, "global")
lcFileExtn = LOWER(JUSTEXT(loXdrPic.ImageFile))
IF !SEEK(BINTOC(tnWB)+lcFileExtn, "xl_contenttypes", "extension")
INSERT INTO xl_contenttypes (workbook, extension, contenttype) VALUES (tnWB, lcFileExtn, "image/" + lcFileExtn)
ENDIF
ENDIF
ENDFOR
ENDIF
CATCH TO loException
SET STEP ON
ENDTRY
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, lcXMLText, 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, lnSize
LOCAL lcStrText, lcCheckSum, loStrings
RAISEEVENT(this, "OnShowStatusMessage", 1, 1)
TRY
lcStrings = FILETOSTR(tcFilePath)
IF this.CodePage = 0
lcStrings = STRCONV(lcStrings, 11)
ELSE
lcStrings = STRCONV(lcStrings, 11, this.CodePage, 1)
ENDIF
lnNode = 0
loStrings = this.AddStringToHeap(lcStrings)
lcString = this.GetXMLFirstSegment(loStrings, 'si')
DO WHILE !EMPTY(lcString)
lnR = 1
lcRichTextRun = this.GetNodeElement(lcString, 'r', lnR, True)
IF EMPTY(lcRichTextRun)
llFormatted = False
lcT = this.GetNodeElement(lcString, 't', 1)
lcXMLText = this.GetNodeElementValue(lcT)
llPrsvSp = IIF(EMPTY(this.GetNodeAttributeValue(lcT, "xml:space")), False, True)
IF llPrsvSp
lcRText = CHRTRAN(lcXMLText, CHR(32), CHR(160))
ENDIF
ELSE
llFormatted = True
lcXMLText = ""
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)
lcXMLText = lcXMLText + lcRText
lcRunProp = this.GetNodeElement(lcRichTextRun, 'rPr', 1, True)
llFBold = IIF(ATC("", lcRunProp)>0, True, False)
llFItalic = IIF(ATC("", lcRunProp)>0, True, False)
llStrkthr = IIF(ATC("')
FOR lnCol=1 TO loGrid.ColumnCount
FWRITE(lhFile, '')
FWRITE(lhFile, '' + this.GetXMLString(loGrid.Columns(lnCol).HeaderCaption) + '')
FWRITE(lhFile, '')
ENDFOR
FWRITE(lhFile, '
')
ELSE
lnRow = tnBegRow - 1
ENDIF
lnDataRow = lnRow + 1
*-* Write the grid field values to cells
lcSETCentury = SET("CENTURY")
SET CENTURY ON
SELECT &lcGridAlias
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '')
FOR lnCol=1 TO loGrid.ColumnCount
lnFmtId = lnCol + loGrid.ColumnCount
TRY
lxCellValue = NVL(EVALUATE(loGrid.Columns(lnCol).ControlSource), "")
IF loGrid.Columns(lnCol).FieldPercent
lxCellValue = lxCellValue / 100
ENDIF
CATCH TO loException
lxCellValue = .NULL.
ENDTRY
IF ISNULL(lxCellValue)
lxCellValue = this.NullValue
ELSE
loGrid.Columns(lnCol).FieldType = VARTYPE(lxCellValue) && Correction provided by vadpost on VFPx to handle calculated field values
ENDIF
lcColRow = this.ColumnIndexToAscii(lnCol+tnBegCol-1) + TRANSFORM(lnRow)
DO CASE
CASE ISNULL(lxCellValue) .OR. (EMPTY(lxCellValue) ;
.AND. (!INLIST(loGrid.Columns(lnCol).FieldType, FIELD_TYPE_INT, FIELD_TYPE_FLOAT, FIELD_TYPE_NUMERIC, FIELD_TYPE_DOUBLE, FIELD_TYPE_CURRENCY, FIELD_TYPE_LOGICAL) ;
.OR. loGrid.Columns(lnCol).Format = 'Z')) && Apply formatting to cell only (change submitted by Doug Hennig)
FWRITE(lhFile, '')
CASE loGrid.Columns(lnCol).FieldType = FIELD_TYPE_DATE
IF lxCellValue >= DATE(1900, 1, 1)
lxCellValue = TRANSFORM(INT(lxCellValue - DATE(1900, 1, 1) + 2))
FWRITE(lhFile, '')
FWRITE(lhFile, '' + TRANSFORM(lxCellValue) + '')
ELSE
lxCellValue = TRANSFORM(lxCellValue)
FWRITE(lhFile, '')
FWRITE(lhFile, '' + this.GetXMLString(lxCellValue) + '')
FWRITE(lhFile, '')
ENDIF
CASE loGrid.Columns(lnCol).FieldType = FIELD_TYPE_DATETIME
IF TTOD(lxCellValue) >= DATE(1900, 1, 1)
lnSetDecimals = SET("DECIMALS")
SET DECIMALS TO 12
lnWholePart = INT(TTOD(lxCellValue) - DATE(1900, 1, 1) + 2)
lnFractPart = ((HOUR(lxCellValue) * 60 + MINUTE(lxCellValue)) * 60 + SEC(lxCellValue)) / (24 * 60 * 60)
lxCellValue = TRANSFORM(lnWholePart + lnFractPart)
FWRITE(lhFile, '')
FWRITE(lhFile, '' + TRANSFORM(lxCellValue) + '')
SET DECIMALS TO (lnSetDecimals)
ELSE
lxCellValue = TRANSFORM(lxCellValue)
FWRITE(lhFile, '')
FWRITE(lhFile, '' + this.GetXMLString(lxCellValue) + '')
FWRITE(lhFile, '')
ENDIF
CASE loGrid.Columns(lnCol).FieldType = FIELD_TYPE_LOGICAL
lxCellValue = IIF(lxCellValue, GETWORDNUM(this.TrueFalseValue, 1, "|"), GETWORDNUM(this.TrueFalseValue, 2, "|"))
FWRITE(lhFile, '')
FWRITE(lhFile, '' + this.GetXMLString(lxCellValue) + '')
FWRITE(lhFile, '')
CASE loGrid.Columns(lnCol).FieldType = FIELD_TYPE_CURRENCY
FWRITE(lhFile, '')
FWRITE(lhFile, '' + TRANSFORM(MTON(lxCellValue)) + '')
CASE INLIST(loGrid.Columns(lnCol).FieldType, FIELD_TYPE_CHAR, FIELD_TYPE_VCHAR, FIELD_TYPE_MEMO)
FWRITE(lhFile, '')
FWRITE(lhFile, '' + this.GetXMLString(ALLTRIM(lxCellValue)) + '')
FWRITE(lhFile, '')
CASE INLIST(loGrid.Columns(lnCol).FieldType, FIELD_TYPE_INT, FIELD_TYPE_FLOAT, FIELD_TYPE_NUMERIC, FIELD_TYPE_DOUBLE)
FWRITE(lhFile, '')
FWRITE(lhFile, '' + TRANSFORM(lxCellValue) + '')
OTHERWISE
FWRITE(lhFile, '')
FWRITE(lhFile, 'Unsupported Field Type')
ENDCASE
ENDFOR
FWRITE(lhFile, '
')
ENDSCAN
*-* Add column sum function if entered for selected columns
IF loGrid.AddSumRow
lnRow = lnRow + 1
FWRITE(lhFile, '')
FOR lnCol=1 TO loGrid.ColumnCount
lcCol = this.ColumnIndexToAscii(lnCol+tnBegCol-1)
lnFmtId = lnCol + loGrid.ColumnCount
IF loGrid.Columns(lnCol).SumColumn
lcFormula = '=SUM(' + lcCol + TRANSFORM(lnDataRow) + ":" + lcCol + TRANSFORM(lnRow-1) + ")"
FWRITE(lhFile, '')
FWRITE(lhFile, '' + lcFormula + '')
ELSE
FWRITE(lhFile, '')
ENDIF
FWRITE(lhFile, '')
ENDFOR
FWRITE(lhFile, '
')
ENDIF
SET CENTURY &lcSETCentury
*-* End the sheet cell data values and worksheet
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
CATCH TO loException
SET STEP ON
llError = True
this.ErrorLevelId = 14
RAISEEVENT(this, "OnShowErrorMessage", 14, loException.message)
FINALLY
IF lhFile > 0
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
ENDIF
*-* Remove the numFmtId for this temporary workbook
lnWB = lnWB - 1
IF lnWB > 0
DIMENSION this.LastNumFmtId[lnWB, 2]
ELSE
this.LastNumFmtId[1, 1] = 0
this.LastNumFmtId[1, 2] = START_NUMERIC_FORMAT_ID
ENDIF
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)
*-* Restore default settings
this.RestoreVFPSettings()
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 = this.CheckSheetName(lcSheetName)
IF ISNULL(lcSheetName)
RETURN False
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, toGrids.Count)
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, '')
FWRITE(lhFile, '')
*-* Write the sheet view information which includes the freeze pane information
FWRITE(lhFile, '')
IF toGrids.List[lnGrid, 3]
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
ENDIF
FWRITE(lhFile, '')
*-* Write sheet Column widths
FWRITE(lhFile, '')
FOR lnCol=1 TO lnColCount
lnColWidth = this.ConvertPixelsToExcelUnits(loGrid.Columns(laColOrder[lnCol, 2]).Width)
FWRITE(lhFile, '')
ENDFOR
FWRITE(lhFile, '')
*-* Write sheet cell data values
lcRowDefHt = ' ht="30"'
FWRITE(lhFile, '')
*-* Place field names in the first row
IF loGrid.HeaderHeight > 0 && Change recommendation by Doug Hennig (if no headers, then no output)
FWRITE(lhFile, '')
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, '
')
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, '')
FOR lnCol=1 TO lnColCount
lxCellValue = EVALUATE(loGrid.Columns(laColOrder[lnCol, 2]).ControlSource)
this.WriteDirectCellValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '
')
ENDSCAN
ELSE
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '')
FOR lnCol=1 TO lnColCount
lxCellValue = EVALUATE(loGrid.Columns(laColOrder[lnCol, 2]).ControlSource)
this.WriteDirectCellFormattedValue(lhFile, lnRow, lnCol, lxCellValue)
ENDFOR
FWRITE(lhFile, '
')
ENDSCAN
ENDIF
SET CENTURY &lcSETCentury
*-* End the sheet cell data values and worksheet
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
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, tnSheet, tnBegRow, tnBegCol
LOCAL lcAlias, lnCol, lnWB, lnSh, lnRow, lcField, lnFldCnt, llError, llOpenedTbl, loException, loReturn
LOCAL lnNdx, lcCaption, lcCol, lnCellStyle
LOCAL ARRAY laFields[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)
tnSheet = 0
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 3
tlSaveWB = False
tcSheetName = JUSTSTEM(tcAlias)
tnSheet = 0
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 4
tcSheetName = JUSTSTEM(tcAlias)
tnSheet = 0
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 5
tnSheet = 0
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 6
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 7
tnBegCol = 1
ENDCASE
IF VARTYPE(tcSheetName) != 'C' .OR. EMPTY(tcSheetName)
tcSheetName = this.DeriveSheetName(tnWB)
ELSE
tcSheetName = this.CheckSheetName(tcSheetName)
IF ISNULL(tcSheetName)
RETURN loReturn
ENDIF
ENDIF
*-* Save current settings and then set to US formats
this.SaveVFPSettings()
*-* Select/Open the table to be exported
DO CASE
CASE USED(tcAlias)
llOpenedTbl = False
lcAlias = tcAlias
CASE OCCURS("\", tcAlias) > 0
TRY
lcAlias = SYS(2015) && JUSTSTEM(tcAlias)
USE (tcAlias) IN 0 ALIAS (lcAlias) SHARED AGAIN
llOpenedTbl = True
CATCH TO loException
llError = True
ENDTRY
IF llError
this.RestoreVFPSettings()
RETURN loReturn
ENDIF
OTHERWISE
this.RestoreVFPSettings()
RETURN loReturn
ENDCASE
*-* Create the workbook
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
this.RestoreVFPSettings()
RETURN loReturn
ENDIF
OTHERWISE
this.RestoreVFPSettings()
RETURN loReturn
ENDCASE
IF lnWB > 0
IF tnSheet = 0
lnSh = this.AddSheet(lnWB, tcSheetName)
ELSE
IF this.GetSheetRecord(lnWB, tnSheet)
lnSh = tnSheet
ELSE
RETURN loReturn
ENDIF
ENDIF
IF lnSh > 0
*-* Get the record count and display a status window
RAISEEVENT(this, "OnShowStatusMessage", 3, 0, RECCOUNT(lcAlias))
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
lnRow = tnBegRow
lnBegCol = tnBegCol
FOR lnCol=1 TO lnFldCnt
this.SetCellValue(lnWb, lnSh, lnRow, lnBegCol, laFields[lnCol, 3])
lnBegCol = lnBegCol + 1
ENDFOR
*-* Populate next rows with data
SELECT &lcAlias
SCAN
lnRow = lnRow + 1
RAISEEVENT(this, "OnShowStatusMessage", 3, lnRow)
lnBegCol = tnBegCol
FOR lnCol=1 TO lnFldCnt
IF laFields[lnCol, 2] = "G"
this.SetCellValue(lnWb, lnSh, lnRow, lnBegCol, "General")
ELSE
this.SetCellValue(lnWb, lnSh, lnRow, lnBegCol, EVALUATE(lcAlias + '.' + laFields[lnCol, 1]))
ENDIF
lnBegCol = lnBegCol + 1
ENDFOR
ENDSCAN
*-* 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
ELSE
lnWB = 0
lnSh = 0
ENDIF
ELSE
lnSh = 0
lnWB = 0
ENDIF
IF llOpenedTbl
USE IN &lcAlias
ENDIF
loReturn.Sheet = lnSh
loReturn.Workbook = lnWB
this.RestoreVFPSettings()
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, tnBegRow, tnBegCol
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)
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 3
tlFreeze = True
tcSheetName = JUSTSTEM(tcAlias)
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 4
tcSheetName = JUSTSTEM(tcAlias)
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 5
tnBegRow = 1
tnBegCol = 1
CASE PCOUNT() = 6
tnBegCol = 1
ENDCASE
IF VARTYPE(tcSheetName) != 'C' .OR. EMPTY(tcSheetName)
tcSheetName = JUSTSTEM(tcAlias)
ENDIF
tcSheetName = this.CheckSheetName(tcSheetName)
IF ISNULL(tcSheetName)
RETURN False
ENDIF
this.SaveVFPSettings()
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
this.RestoreVFPSettings()
RETURN False
ENDIF
OTHERWISE
this.RestoreVFPSettings()
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
*-* Write the workbook
DIMENSION laSheetNames[1]
laSheetNames[1] = tcSheetName
IF this.WriteDirectXMLs(lcTempPath, @laSheetNames, 1)
TRY
lcFileName = lcTempPath + "xl\worksheets\sheet1.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
*-* Write sheet XML header information
FWRITE(lhFile, '')
FWRITE(lhFile, '')
*-* Write the sheet view information which includes the freeze pane information
FWRITE(lhFile, '')
IF tlFreeze
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
ELSE
FWRITE(lhFile, '')
ENDIF
FWRITE(lhFile, '')
*-* Write sheet cell data values
FWRITE(lhFile, '')
*-* Place field names in the first row
lcRowDefHt = ' ht="30"'
FWRITE(lhFile, '')
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
FOR lnCol=1 TO lnFldCnt
this.WriteAsInLineString(lhFile, tnBegRow, lnCol+tnBegCol-1, taFields[lnCol, 2])
ENDFOR
ELSE
FOR lnCol=1 TO lnFldCnt
this.WriteAsInLineFormattedString(lhFile, tnBegRow, lnCol+tnBegCol-1, taFields[lnCol, 2])
ENDFOR
ENDIF
FWRITE(lhFile, '
')
*-* Write the table field values to cells
lcSETCentry = SET("CENTURY")
SET CENTURY ON
lnRow = tnBegRow
IF this.DefaultFont = "Calibri" .AND. this.DefaultFontSize = 11
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '')
FOR lnCol=1 TO lnFldCnt
lxCellValue = EVALUATE(lcAlias + '.' + taFields[lnCol, 1])
this.WriteDirectCellValue(lhFile, lnRow, lnCol+tnBegCol-1, lxCellValue)
ENDFOR
FWRITE(lhFile, '
')
ENDSCAN
ELSE
SCAN
lnRow = lnRow + 1
FWRITE(lhFile, '')
FOR lnCol=1 TO lnFldCnt
lxCellValue = EVALUATE(lcAlias + '.' + taFields[lnCol, 1])
this.WriteDirectCellFormattedValue(lhFile, lnRow, lnCol+tnBegCol-1, lxCellValue)
ENDFOR
FWRITE(lhFile, '
')
ENDSCAN
ENDIF
SET CENTURY &lcSETCentry
*-* End the sheet cell data values and worksheet
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
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
this.RestoreVFPSettings()
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE SaveVFPSettings && Saves the VFP system settings
IF !this.VFPSettings.ValuesSet
this.VFPSettings.ValuesSet = True
this.VFPSettings.Alias = ALIAS()
this.VFPSettings.Currency = SET("CURRENCY", 1) && Bug identified by Doug Hennig
this.VFPSettings.Exact = SET("EXACT")
this.VFPSettings.Safety = SET("SAFETY")
this.VFPSettings.SetDeleted = SET("DELETED")
this.VFPSettings.SetPoint = SET("POINT") && Not previously set (bug identified by Doug Hennig)
this.VFPSettings.Separator = SET("SEPARATOR") && Not previously set (bug identified by Doug Hennig)
IF this.VFPSettings.SetPoint != "."
SET POINT TO "."
ENDIF
IF this.VFPSettings.Separator != ","
SET SEPARATOR TO ","
ENDIF
SET EXACT OFF
SET SAFETY OFF
SET DELETED ON
ENDIF
ENDPROC
PROCEDURE SaveWorkbook && Saves the selected workbook as an XLSX file
LPARAMETERS tnWB
LOCAL lcTempPath, llReturn, lcSafety, lnTotStages, lcRelsFileName, loException, lcFileName, lcBaseContentType, lcWbXmlPath
LOCAL lcExtnFileName, lcFileContent, lcBaseType, lnStage, lcExact, lhWBRels, lhCTFile, lnTotStrCnt, lnUnqStrCnt
LOCAL ARRAY laCount[1]
llReturn = False
loException = .NULL.
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
llReturn = True
*-* Write the XLSX Workbook to XML structures
lcTempPath = this.CreateWorkingDirectories()
IF ISNULL(lcTempPath)
llReturn = False
ELSE
this.SaveVFPSettings()
lcTempPath = ADDBS(lcTempPath)
TRY
SELECT COUNT(*) FROM xl_sheets WHERE workbook = tnWB .AND. shdeleted = False INTO ARRAY laCount
lnStage = 0
lnTotStages = NVL(laCount[1], 1) + 5
RAISEEVENT(this, "OnShowStatusMessage", 2, 0, lnTotStages)
*-* Write the workbook and fixed support XMLs
lnStage = lnStage + 1
RAISEEVENT(this, "OnShowStatusMessage", lnStage, lnTotStages)
IF !this.WriteWorkbookXML(tnWB, lcTempPath)
THROW
ENDIF
IF !this.WriteSupportXMLs(tnWB, lcTempPath)
THROW
ENDIF
*-* Get the number of unique strings assigned and total strings assigned
SELECT xl_strformat
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB .AND. !DELETED() TO lnTotStrCnt
SELECT xl_strings
SET ORDER TO TAG sortorder
COUNT FOR workbook = tnWB .AND. !DELETED() TO lnUnqStrCnt
lnTotStrCnt = lnTotStrCnt + lnUnqStrCnt
*-* If no strings are assigned to cells; remove SharedStrings.xml from relationships
IF lnTotStrCnt = 0
DELETE FROM xl_relationships WHERE workbook = tnWB AND reltype = RELS_TYPE_SHAREDSTRINGS
ENDIF
*-* Write the contents type xml
lnStage = lnStage + 1
RAISEEVENT(this, "OnShowStatusMessage", lnStage, lnTotStages)
lcFileName = lcTempPath + "[Content_Types].xml"
lhCTFile = FCREATE(lcFileName)
IF lhCTFile < 0
THROW
ENDIF
FWRITE(lhCTFile, '')
FWRITE(lhCTFile, '')
SELECT xl_contenttypes
SCAN FOR workbook = tnWB .AND. !DELETED()
FWRITE(lhCTFile, '')
ENDSCAN
IF xl_workbooks.macroenabled
FWRITE(lhCTFile, '')
ELSE
FWRITE(lhCTFile, '')
ENDIF
lcBaseContentType = 'application/vnd.openxmlformats-officedocument.spreadsheetml.'
SELECT xl_relationships
SCAN FOR workbook = tnWB .AND. !DELETED()
DO CASE
CASE xl_relationships.reltype = RELS_TYPE_CALCCHAIN
* FWRITE(lhCTFile, '')
CASE xl_relationships.reltype = RELS_TYPE_DRAWING
FWRITE(lhCTFile, '')
CASE xl_relationships.reltype = RELS_TYPE_EXTNLINK
FWRITE(lhCTFile, '')
CASE xl_relationships.reltype = RELS_TYPE_SHAREDSTRINGS
FWRITE(lhCTFile, '')
CASE xl_relationships.reltype = RELS_TYPE_STYLES
FWRITE(lhCTFile, '')
CASE xl_relationships.reltype = RELS_TYPE_THEME
FWRITE(lhCTFile, '')
CASE xl_relationships.reltype = RELS_TYPE_WORKSHEET
FWRITE(lhCTFile, '')
ENDCASE
ENDSCAN
FWRITE(lhCTFile, '')
FWRITE(lhCTFile, '')
FWRITE(lhCTFile, '')
FCLOSE(lhCTFile)
this.SaveAsUTF8(lcFileName)
*-* Write the Workbook Relationship file
lnStage = lnStage + 1
RAISEEVENT(this, "OnShowStatusMessage", lnStage, lnTotStages)
lcRelsFileName = lcTempPath + "xl\_rels\workbook.xml.rels"
lhWBRels = FCREATE(lcRelsFileName)
IF lhWBRels < 0
THROW
ENDIF
lcWbXmlPath = lcTempPath + "xl\"
lcBaseType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/"
FWRITE(lhWBRels, '')
FWRITE(lhWBRels, '')
SELECT xl_relationships
SCAN FOR workbook = tnWB .AND. relsrc = RELS_SRC_WORKBOOK
FWRITE(lhWBRels, '')
DO CASE
CASE xl_relationships.reltype = RELS_TYPE_CALCCHAIN
lcExtnFileName = lcWbXmlPath + ALLTRIM(xl_relationships.target)
lcFileContent = ALLTRIM(xl_relationships.filecontent)
this.ConvertStringToFile(lcFileContent, lcExtnFileName)
CASE xl_relationships.reltype = RELS_TYPE_EXTNLINK
lcExtnFileName = lcWbXmlPath + ALLTRIM(xl_relationships.target)
lcFileContent = ALLTRIM(xl_relationships.filecontent)
this.ConvertStringToFile(lcFileContent, lcExtnFileName, 14)
lcExtnFileName = ADDBS(JUSTPATH(lcExtnFileName)) + "_rels\" + JUSTSTEM(lcExtnFileName) + ".xml.rels"
lcFileContent = ALLTRIM(xl_relationships.relscontent)
this.ConvertStringToFile(lcFileContent, lcExtnFileName, 14)
CASE xl_relationships.reltype = RELS_TYPE_THEME
lcExtnFileName = lcWbXmlPath + ALLTRIM(xl_relationships.target)
lcFileContent = ALLTRIM(xl_relationships.filecontent)
this.ConvertStringToFile(lcFileContent, lcExtnFileName)
CASE xl_relationships.reltype = RELS_TYPE_VBAPROJECT
lcExtnFileName = lcWbXmlPath + ALLTRIM(xl_relationships.target)
lcFileContent = ALLTRIM(xl_relationships.filecontent)
this.ConvertStringToFile(lcFileContent, lcExtnFileName, 14)
CASE xl_relationships.reltype = RELS_TYPE_WORKSHEET
IF SEEK(BINTOC(tnWB)+BINTOC(xl_relationships.sheet), "xl_sheets", "sheet")
lnStage = lnStage + 1
RAISEEVENT(this, "OnShowStatusMessage", lnStage, lnTotStages)
IF !this.WriteSheetXMLs(tnWB, xl_sheets.sheet, lcTempPath)
THROW
ENDIF
ELSE
THROW
ENDIF
CASE xl_relationships.reltype = RELS_TYPE_SHAREDSTRINGS
IF !this.WriteStringsXML(tnWB, lcTempPath, lnTotStrCnt, lnUnqStrCnt)
THROW
ENDIF
CASE xl_relationships.reltype = RELS_TYPE_STYLES
IF !this.WriteStylesXML(tnWB, lcTempPath)
THROW
ENDIF
CASE xl_relationships.reltype = RELS_TYPE_UNKNOWN
ENDCASE
ENDSCAN
FWRITE(lhWBRels, '')
FCLOSE(lhWBRels)
this.SaveAsUTF8(lcRelsFileName)
llReturn = this.CreateExcelFile(lcTempPath, xl_workbooks.filepath, xl_workbooks.wbname, xl_workbooks.macroenabled)
CATCH TO loException
llReturn = False
SET STEP ON
ENDTRY
this.RemoveWorkingDirectories(lcTempPath)
this.RestoreVFPSettings()
RAISEEVENT(this, "OnShowStatusMessage", 2, -1)
ENDIF
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE SaveWorkbookAs && Saves the selected workbook with the new name
LPARAMETERS tnWB, tcWBName
LOCAL lcName, lcPath, llReturn
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
llReturn = this.SaveWorkbook(tnWB)
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE SetCellAlignment && Sets the cell horizontal and vertical alignments
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tcHorizAlign, tcVertAlign
LOCAL llReturn, lnCellXfsId
DO CASE
CASE this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
CASE PCOUNT() < 4
RETURN False
ENDCASE
IF this.GetSheetRecord(tnWB, tnSheet)
this.SaveVFPSettings()
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, CELL_HORIZ_ALIGN_DISTRIB, CELL_HORIZ_ALIGN_CTR_CONTIN, CELL_HORIZ_ALIGN_JUSTIFIED, CELL_HORIZ_ALIGN_GENERAL) .AND. ;
INLIST(tcVertAlign, CELL_VERT_ALIGN_TOP, CELL_VERT_ALIGN_BOTTOM, CELL_VERT_ALIGN_CENTER, CELL_VERT_ALIGN_DISTRIB, CELL_VERT_ALIGN_JUSTIFIED)
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, CELL_HORIZ_ALIGN_DISTRIB, CELL_HORIZ_ALIGN_CTR_CONTIN, CELL_HORIZ_ALIGN_JUSTIFIED, CELL_HORIZ_ALIGN_GENERAL)
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, CELL_VERT_ALIGN_DISTRIB, CELL_VERT_ALIGN_JUSTIFIED)
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
this.RestoreVFPSettings()
ELSE
llReturn = False
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
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
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, 0, '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
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
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, 0, 'xl_fills')
INSERT INTO xl_fills (workbook, id, fgcolor, bgcolor, patttype, theme, tint, fgindexed, bgindexed, fgtheme, bgtheme) ;
VALUES (tnWB, lnFillId, tnFColor, tnBColor, tcPatternType, 0, 0, lnFIndex, lnBIndex, -1, -1)
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
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
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
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, 0, '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
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
IF PCOUNT() < 5 .OR. VARTYPE(tcCellFormula) != "C" .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF this.GetCellRecord(tnWB, tnSheet, tnCellRow, tnCellCol)
REPLACE xl_cells.cellvalue WITH "", ;
xl_cells.stringid WITH 0, ;
xl_cells.datatype WITH DATA_TYPE_FORMULA, ;
xl_cells.formulatype WITH "", ;
xl_cells.formulasi WITH -1, ;
xl_cells.celldeleted WITH False IN xl_cells
ELSE
INSERT INTO xl_cells (workbook, sheet, cellrow, cellcol, datatype, formulatype, formulasi, cellxfs, celldeleted, numdec, validndx) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, DATA_TYPE_FORMULA, "", -1, 0, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnCellRow)+BINTOC(tnCellCol), "xl_formulas", "cell")
REPLACE xl_formulas.formulatype WITH "", ;
xl_formulas.si WITH -1, ;
xl_formulas.ref WITH "", ;
xl_formulas.formrel WITH "", ;
xl_formulas.cellformula WITH tcCellFormula IN xl_formulas
ELSE
INSERT INTO xl_formulas (workbook, sheet, cellrow, cellcol, formulatype, si, ref, formrel, cellformula) ;
VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, "", -1, "", "", tcCellFormula)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE SetCellIndent && Sets the cell indentation value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnIndent
LOCAL lnCellXfsId
IF PCOUNT() != 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF VARTYPE(tnIndent) != 'N'
RETURN False
ENDIF
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
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
IF this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF tnWB = toInLine.Workbook
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.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
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE SetCellNumberDecimals && Sets the number of decimals to display
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnNumDecimals
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF VARTYPE(tnNumDecimals) != 'N' .OR. tnNumDecimals < 0
RETURN False
ENDIF
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
RETURN True
ENDPROC
PROCEDURE SetCellNumberFormat && Sets the cell number format
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tnNumFmtId
LOCAL llReturn, lnNumFmtId, loException, lcFormatCode
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF VARTYPE(tnNumFmtId) != 'N'
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
DO CASE
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MDYYHMM
lcFormatCode = CHRTRAN("[$-409]m|d|yy h:mm", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_DDMMMYYYY_TTAM
lcFormatCode = CHRTRAN("[$-409]dd|mmm|yyyy h:mm AM/PM;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_DDMMMYYYY_TT24
lcFormatCode = CHRTRAN("[$-409]dd|mmm|yyyy h:mm;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MMMDDYYYY_TTAM
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, '[$-409]mmm d, yyyy h:mm AM/PM;@')
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MMMDDYYYY_TT24
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, '[$-409]mmm d, yyyy hh:mm;@')
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MDYY_TTAM
lcFormatCode = CHRTRAN("[$-409]m|d|yy h:mm AM/PM;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
CASE tnNumFmtId = CELL_FORMAT_DATETIME_MDYY_TT24
lcFormatCode = CHRTRAN("[$-409]m|d|yy hh:mm;@", "|", this.DateTimeSeparator)
lnNumFmtId = this.AddCustomDateTimeFormat(tnWB, lcFormatCode)
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
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
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, tnCellRow, tnCellCol)
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
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
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, tlAppend
LOCAL lcCellValue, lcDataType, lnStringId, lnSetDecimals, lnWholePart, lnFractPart, lnNumFmtId, lcHorzAlign
LOCAL llReturn
IF PCOUNT() < 5 .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
IF PCOUNT() = 5
tlAppend = False
ENDIF
llReturn = True
TRY
this.SaveVFPSettings()
*-* 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
lnStringId = -1
lcHorzAlign = ""
lnNumFmtId = 0
lcDataType = VARTYPE(txCellValue)
IF ISNULL(txCellValue)
txCellValue = this.NullValue
ENDIF
DO CASE
CASE ISNULL(txCellValue)
THROW
CASE lcDataType = DATA_TYPE_LOGICAL
lcCellValue = IIF(txCellValue, GETWORDNUM(this.TrueFalseValue, 1, "|"), GETWORDNUM(this.TrueFalseValue, 2, "|"))
CASE lcDataType = DATA_TYPE_CHAR
txCellValue = ALLTRIM(txCellValue)
IF tlAppend
lcCellValue = this.GetCellValue(tnWB, tnSheet, tnCellRow, tnCellCol)
IF EMPTY(lcCellValue) .OR. ISNULL(lcCellValue)
lcCellValue = txCellValue
ELSE
lcCellValue = lcCellValue + CR + txCellValue
ENDIF
ELSE
lcCellValue = txCellValue
ENDIF
IF LEN(lcCellValue) > LIMITS_MAX_CELL_CHARS
THROW
ENDIF
CASE lcDataType = DATA_TYPE_DATE
IF txCellValue >= DATE(1900, 1, 1)
lcCellValue = TRANSFORM(INT(txCellValue - DATE(1900, 1, 1) + 2))
ELSE
lcDataType = DATA_TYPE_CHAR
lcCellValue = "StringValue"
lcSetDate = SET("DATE")
SET DATE TO AMERICAN
lnStringId = this.AddStringValue(tnWB, TRANSFORM(txCellValue), False)
SET DATE TO (lcSetDate)
ENDIF
lcHorzAlign = CELL_HORIZ_ALIGN_LEFT
lnNumFmtId = CELL_FORMAT_DATE_MMDDYY
CASE lcDataType = DATA_TYPE_DATETIME
IF TTOD(txCellValue) >= DATE(1900, 1, 1)
lnSetDecimals = SET("DECIMALS")
SET DECIMALS TO 12
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
lnStringId = this.AddStringValue(tnWB, TRANSFORM(txCellValue), False)
SET DATE TO (lcSetDate)
ENDIF
lcHorzAlign = CELL_HORIZ_ALIGN_LEFT
lnNumFmtId = CELL_FORMAT_DATETIME_MMMDDYYYY_TTAM
CASE lcDataType = DATA_TYPE_FLOAT
lcCellValue = TRANSFORM(txCellValue)
IF ATC(".", lcCellValue) = 0
lcDataType = DATA_TYPE_INT
ENDIF
CASE lcDataType = 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+",", "")
lcHorzAlign = CELL_HORIZ_ALIGN_RIGHT
DO CASE
CASE lcCurrency = "£"
lnNumFmtId = CELL_FORMAT_ACC_CURR_POUNDS
CASE lcCurrency = "€"
lnNumFmtId = CELL_FORMAT_ACC_CURR_EURO
OTHERWISE
lnNumFmtId = CELL_FORMAT_CURRENCY_PAREN
ENDCASE
ENDIF
CASE 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
IF lnNumFmtId = 0
lnCellXfsId = xl_cells.cellxfs
ELSE
lnCellXfsId = this.GetCellXfsId(tnWB, lnNumFmtId, 0, 0, 0, "", "", 0, 0, 0)
ENDIF
ENDIF
REPLACE xl_cells.cellvalue WITH lcCellValue, ;
xl_cells.cellxfs WITH lnCellXfsId, ;
xl_cells.stringid WITH lnStringId, ;
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, lnStringId, lcDataType, lnCellXfsId, False, -1, 0)
this.SetRowMaxColumn(tnWB, tnSheet, tnCellRow, tnCellCol)
ENDIF
DELETE FROM xl_formulas WHERE workbook = tnWB AND sheet = tnSheet AND cellrow = tnCellRow AND cellcol = tnCellCol
this.RestoreVFPSettings()
CATCH TO loException
llReturn = False
ENDTRY
RETURN llReturn
ENDPROC
PROCEDURE SetCellWordWrap && Sets the cell word-wrapping value
LPARAMETERS tnWB, tnSheet, tnCellRow, tnCellCol, tlWordWrap
LOCAL llReturn, lnWrapText, lnCellXfsId
IF PCOUNT() < 5 .OR. VARTYPE(tlWordWrap) != "L" .OR. this.IsCellReferenceInvalid(tnCellRow, tnCellCol)
RETURN False
ENDIF
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
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
IF PCOUNT() < 4
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetColWidthKeyExpr(tnWB, tnSheet, tnColumn), "xl_columns", "col")
REPLACE xl_columns.bestfit WITH tlBestFit IN xl_columns
ELSE
INSERT INTO xl_columns (workbook, sheet, col, bestfit) VALUES (tnWB, tnSheet, tnColumn, tlBestFit)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE SetColumnHidden && Sets the column hidden setting
LPARAMETERS tnWB, tnSheet, tnColumn, tlHidden
LOCAL llReturn, lcAlias, lnHidden
IF PCOUNT() < 4 .OR. VARTYPE(tlHidden) != "L"
RETURN False
ENDIF
lnHidden = IIF(tlHidden, 1, 0)
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetColWidthKeyExpr(tnWB, tnSheet, tnColumn), "xl_columns", "col")
REPLACE xl_columns.hidden WITH lnHidden IN xl_columns
ELSE
INSERT INTO xl_columns (workbook, sheet, col, hidden, bestfit) VALUES (tnWB, tnSheet, tnColumn, lnHidden, False)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE SetColumnWidth && Sets the column width
LPARAMETERS tnWB, tnSheet, tnColumn, tnWidth
LOCAL llReturn
IF PCOUNT() < 4 .OR. VARTYPE(tnWidth) != "N"
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetColWidthKeyExpr(tnWB, tnSheet, tnColumn), "xl_columns", "col")
REPLACE xl_columns.width WITH tnWidth IN xl_columns
ELSE
INSERT INTO xl_columns (workbook, sheet, col, width, bestfit) VALUES (tnWB, tnSheet, tnColumn, tnWidth, False)
ENDIF
llReturn = True
ELSE
llReturn = False
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
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
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
IF PCOUNT() < 2
RETURN False
ENDIF
IF VARTYPE(tcLStyle) != "C"
tcLStyle = BORDER_STYLE_NONE
ENDIF
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
RETURN True
ENDPROC
PROCEDURE SetDefaultFill && Sets the default fill for the workbook
LPARAMETERS tnWB, tcPatternType, tnFColor, tnBColor
LOCAL lnFIndex, lnBIndex
IF PCOUNT() < 2
RETURN False
ENDIF
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, fgtheme, bgtheme) ;
VALUES (tnWB, 0, tnFColor, tnBColor, tcPatternType, 0, 0, lnFIndex, lnBIndex, -1, -1)
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
IF PCOUNT() < 2
RETURN False
ENDIF
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
RETURN true
ENDPROC
PROCEDURE SetDisplayGridLines && Sets the sheet display grid lines setting
LPARAMETERS tnWB, tnSheet, tlGridLines
IF PCOUNT() = 3 .AND. VARTYPE(tlGridLines) = "L" .AND. this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.gridlines WITH IIF(tlGridLines, 1, 0) IN xl_sheets
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE SetHeaderFooterSetup && Sets the header and footer setup for the sheet
LPARAMETERS tnWB, tnSheet, tlAlignMargin, tlDiffFirstPg, tlDiffOddEven, tlScaleWDoc
LOCAL llReturn
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
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
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
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
RETURN llReturn
ENDPROC
PROTECTED PROCEDURE SetLastId && Sets the last used Id Value for strings, borders, fills, fonts, and cellxfs
LPARAMETERS tnWB, tnSheet, tnLastId, tcCursor
LOCAL lnNdx
DO CASE
CASE tcCursor = "global"
lnNdx = ASCAN(this.GlobalId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.GlobalId[lnNdx, 2] = tnLastId
ELSE
IF this.GlobalId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.GlobalId, 1) + 1
ENDIF
DIMENSION this.GlobalId[lnNdx, 2]
this.GlobalId[lnNdx, 1] = tnWB
this.GlobalId[lnNdx, 2] = tnLastId
ENDIF
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_sheet_rels"
lcKey = BINTOC(tnWB)+BINTOC(tnSheet)
lnNdx = ASCAN(this.LastSheetRelsId, lcKey, 1, -1, 1, 15)
IF lnNdx > 0
this.LastSheetRelsId[lnNdx, 2] = tnLastId
ELSE
IF EMPTY(this.LastSheetRelsId[1, 1])
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastSheetRelsId, 1) + 1
ENDIF
DIMENSION this.LastSheetRelsId[lnNdx, 2]
this.LastSheetRelsId[lnNdx, 1] = lcKey
this.LastSheetRelsId[lnNdx, 2] = tnLastId
ENDIF
CASE tcCursor = "xl_drawing_rels"
lcKey = BINTOC(tnWB)+BINTOC(tnSheet)
lnNdx = ASCAN(this.LastDrawingRelsId, lcKey, 1, -1, 1, 15)
IF lnNdx > 0
this.LastDrawingRelsId[lnNdx, 2] = tnLastId
ELSE
IF EMPTY(this.LastDrawingRelsId[1, 1])
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastDrawingRelsId, 1) + 1
ENDIF
DIMENSION this.LastDrawingRelsId[lnNdx, 2]
this.LastDrawingRelsId[lnNdx, 1] = lcKey
this.LastDrawingRelsId[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_workbook_rels"
lnNdx = ASCAN(this.LastWorkbookRelsId, tnWB, 1, -1, 1, 15)
IF lnNdx > 0
this.LastWorkbookRelsId[lnNdx, 2] = tnLastId
ELSE
IF this.LastWorkbookRelsId[1, 1] = 0
lnNdx = 1
ELSE
lnNdx = ALEN(this.LastWorkbookRelsId, 1) + 1
ENDIF
DIMENSION this.LastWorkbookRelsId[lnNdx, 2]
this.LastWorkbookRelsId[lnNdx, 1] = tnWB
this.LastWorkbookRelsId[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
OTHERWISE
SET STEP ON
ENDCASE
ENDPROC
PROCEDURE SetPaperSize && Sets the paper size for the selected sheet
LPARAMETERS tnWB, tnSheet, tnPaperSize
LOCAL llReturn, lcAlias
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
RETURN llReturn
ENDPROC
PROCEDURE SetPrintArea && Sets the print area for the sheet
LPARAMETERS tnWB, tnSheet, tnBegRow, tnBegCol, tnEndRow, tnEndCol
IF PCOUNT() < 6
RETURN False
ENDIF
IF tnBegRow > tnEndRow .OR. tnBegCol > tnEndCol
RETURN False
ENDIF
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook") .AND. SEEK(BINTOC(tnWB)+PADL("_xlnm.PRINT_AREA", 50, " "), "xl_namerange", "wbrname")
UPDATE xl_namerange ;
SET begrow = tnBegRow, ;
begcol = tnBegCol, ;
endrow = tnEndRow, ;
endcol = tnEndCol ;
WHERE workbook = tnWB ;
AND sheet = tnSheet ;
AND rname = PADL("_xlnm.PRINT_AREA", 50, " ")
ELSE
INSERT INTO xl_namerange (workbook, sheet, rname, scope, begrow, begcol, endrow, endcol) ;
VALUES (tnWB, tnSheet, "_xlnm.PRINT_AREA", SCOPE_SH_NAMED_RANGE, tnBegRow, tnBegCol, tnEndRow, tnEndCol)
ENDIF
RETURN True
ENDPROC
PROCEDURE SetPrintFitToHeight && Number of vertical pages to fit on for printing
LPARAMETERS tnWB, tnSheet, tnFitToHeight
LOCAL llReturn
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
RETURN llReturn
ENDPROC
PROCEDURE SetPrintFitToWidth && Number of horizontal pages to fit on for printing
LPARAMETERS tnWB, tnSheet, tnFitToWidth
LOCAL llReturn
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
RETURN llReturn
ENDPROC
PROCEDURE SetPrintOrientation && Sets the printer orientation for sheet output
LPARAMETERS tnWB, tnSheet, tnOrientation
LOCAL llReturn
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.prnorient WITH tnOrientation IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE SetRowHeight && Sets the row height
LPARAMETERS tnWB, tnSheet, tnRow, tnHeight
LOCAL llReturn
IF PCOUNT() < 4 .OR. VARTYPE(tnHeight) != "N"
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(this.GetRowHeightKeyExpr(tnWB, tnSheet, tnRow), "xl_rows", "row")
REPLACE xl_rows.height WITH tnHeight IN xl_rows
ELSE
INSERT INTO xl_rows (workbook, sheet, row, height, hidden) VALUES (tnWB, tnSheet, tnRow, tnHeight, 0)
ENDIF
llReturn = True
ELSE
llReturn = False
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
PROCEDURE SetRowHidden && Sets the row hidden setting
LPARAMETERS tnWB, tnSheet, tnRow, tlHidden
LOCAL llReturn, lnHidden
LOCAL ARRAY laRowRecord[1]
IF PCOUNT() < 4 .OR. VARTYPE(tlHidden) != "L"
RETURN False
ENDIF
lnHidden = IIF(tlHidden, 1, 0)
IF this.GetSheetRecord(tnWB, tnSheet)
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(tnRow), "xl_rows", "row")
REPLACE xl_rows.hidden WITH lnHidden IN xl_rows
ELSE
SELECT height, rowlevel, collapsed FROM xl_rows WHERE workbook = tnWB AND sheet = tnSheet AND row = tnRow-1 INTO ARRAY laRowRecord
INSERT INTO xl_rows (workbook, sheet, row, height, rowlevel, collapsed, hidden) ;
VALUES (tnWB, tnSheet, tnRow, NVL(laRowRecord[1, 1], -1), NVL(laRowRecord[1, 2], 0), NVL(laRowRecord[1, 3], False), lnHidden)
ENDIF
llReturn = True
ELSE
llReturn = False
ENDIF
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", "row")
IF xl_rows.maxcol < tnCellCol
REPLACE xl_rows.maxcol WITH tnCellCol IN xl_rows
ENDIF
ELSE
INSERT INTO xl_rows (workbook, sheet, row, maxcol, height, hidden) VALUES (tnWB, tnSheet, tnCellRow, tnCellCol, -1.00, 0)
ENDIF
ENDPROC
PROCEDURE SetSheetGroupSettings && Sets the group settings for a given sheet
LPARAMETERS tnWB, tnSheet, tlSummaryBelow, tlSummaryRight
LOCAL llReturn
DO CASE
CASE PCOUNT() = 0 .OR. PCOUNT() = 1
RETURN False
CASE PCOUNT() = 2
tlSummaryBelow = True
tlSummaryRight = True
CASE PCOUNT() = 3
tlSummaryRight = True
ENDCASE
IF VARTYPE(tlSummaryBelow) != "L" .OR. VARTYPE(tlSummaryRight) != "L"
RETURN False
ENDIF
IF this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.grpsumbelow WITH IIF(tlSummaryBelow, 0, 1), ;
xl_sheets.grpsumright WITH IIF(tlSummaryRight, 0, 1) IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
RETURN llReturn
ENDPROC
PROCEDURE SetSheetMargins && Sets the sheet margin values
LPARAMETERS tnWB, tnSheet, tnLeft, tnRight, tnTop, tnbot, tnHeader, tnFooter
LOCAL llReturn
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
RETURN llReturn
ENDPROC
PROCEDURE SetSheetPrintOptions && Sets the sheet print options
LPARAMETERS tnWB, tnSheet, txPrnOptCenH, txPrnOptCenV, txPrnOptHead, txPrnOptGrid
LOCAL llReturn, loException
DO CASE
CASE PCOUNT() < 3
RETURN False
CASE PCOUNT() = 3
tnPrnOptCenV = 0
tnPrnOptHead = 0
tnPrnOptGrid = 0
CASE PCOUNT() = 4
tnPrnOptHead = 0
tnPrnOptGrid = 0
CASE PCOUNT() = 5
tnPrnOptGrid = 0
ENDCASE
TRY
IF this.GetSheetRecord(tnWB, tnSheet)
txPrnOptCenH = CAST(txPrnOptCenH AS INTEGER)
txPrnOptCenV = CAST(txPrnOptCenV AS INTEGER)
txPrnOptHead = CAST(txPrnOptHead AS INTEGER)
txPrnOptGrid = CAST(txPrnOptGrid AS INTEGER)
REPLACE xl_sheets.prnopthead WITH txPrnOptHead, ;
xl_sheets.prnoptgrid WITH txPrnOptGrid, ;
xl_sheets.prnoptctrh WITH txPrnOptCenH, ;
xl_sheets.prnoptctrv WITH txPrnOptCenV IN xl_sheets
llReturn = True
ELSE
llReturn = False
ENDIF
CATCH TO loException
llReturn = False
ENDTRY
RETURN llReturn
ENDPROC
PROCEDURE SetSheetProtection && Sets the sheet protection on or off
LPARAMETERS tnWB, tnSheet, toProtection
LOCAL llReturn
IF VARTYPE(toProtection) = "O" .AND. PEMSTATUS(toProtection, "Locked", 5) .AND. this.GetSheetRecord(tnWB, tnSheet)
IF toProtection.Locked .AND. EMPTY(toProtection.Password)
toProtection.Password = this.DefaultPW
ENDIF
TRY
BEGIN TRANSACTION
REPLACE xl_sheets.protection WITH toProtection.Locked, ;
xl_sheets.algorithm WITH toProtection.AlgorithmName, ;
xl_sheets.password WITH toProtection.Password, ;
xl_sheets.autoFilter WITH toProtection.AutoFilter, ;
xl_sheets.deletecol WITH toProtection.DeleteColumns, ;
xl_sheets.deleterow WITH toProtection.DeleteRows, ;
xl_sheets.formatcell WITH toProtection.FormatCells, ;
xl_sheets.formatcol WITH toProtection.FormatColumns, ;
xl_sheets.formatrow WITH toProtection.FormatRows, ;
xl_sheets.insertcol WITH toProtection.InsertColumns, ;
xl_sheets.insertrow WITH toProtection.InsertRows, ;
xl_sheets.inserthyper WITH toProtection.InsertHyperlinks, ;
xl_sheets.pivottbl WITH toProtection.pivotTables, ;
xl_sheets.Sellocked WITH toProtection.SelectLockedCells, ;
xl_sheets.Selunlocked WITH toProtection.SelectUnlockedCells, ;
xl_sheets.sort WITH toProtection.Sort, ;
xl_sheets.objects WITH toProtection.Objects, ;
xl_sheets.scenarios WITH toProtection.Scenarios IN xl_sheets
END TRANSACTION
llReturn = True
CATCH TO loException
ROLLBACK
llReturn = False
ENDTRY
ELSE
llReturn = False
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
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
RETURN llReturn
ENDPROC
PROCEDURE SetSheetVisibility && Sets the sheet visibility
LPARAMETERS tnWB, tnSheet, tnVisiblity
LOCAL llReturn
llReturn = False
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
RETURN llReturn
ENDPROC
PROCEDURE SetTabColor && Sets the sheet tab color
LPARAMETERS tnWB, tnSheet, tnRBGColor
IF PCOUNT() = 3 .AND. this.GetSheetRecord(tnWB, tnSheet)
REPLACE xl_sheets.tabcolorndx WITH 0, ;
xl_sheets.tabcolorrgb WITH this.ConvertColorToHex(tnRBGColor) IN xl_sheets
ELSE
RETURN False
ENDIF
RETURN True
ENDPROC
PROCEDURE SetWorkbookProtection && Sets the Workbook protection
LPARAMETERS tnWB, tlLocked, tcPassword, tcAlgorithm
IF SEEK(BINTOC(tnWB), "xl_workbooks", "workbook")
DO CASE
CASE PCOUNT() = 0
RETURN False
CASE PCOUNT() = 1
tlLocked = False
tcPassword = ""
tcAlgorithm = ""
CASE PCOUNT() = 2
IF tlLocked
tcPassword = "F771" && encoded vfpxworkbookxlsx
tcAlgorithm = ""
ELSE
tcPassword = ""
tcAlgorithm = ""
ENDIF
CASE PCOUNT() = 3
tcAlgorithm = ""
ENDCASE
REPLACE xl_workbooks.protection WITH tlLocked, ;
xl_workbooks.password WITH tcPassword, ;
xl_workbooks.algorithm WITH tcAlgorithm IN xl_workbooks
RETURN True
ELSE
RETURN False
ENDIF
ENDPROC
PROCEDURE TestCode && Method to test code for debugging
LOCAL llCreated, lcZipPath, lcTempZip
lcZipPath = "E:\My Work\FoxPro\Projects\WorkbookXLSX\Test Spreadsheets\Test\Temp"
this.SaveAsUTF8(lcZipPath + "\xl\worksheets\sheet1.xml")
lcTempZip = "E:\My Work\FoxPro\Projects\WorkbookXLSX\Test Spreadsheets\Test2\UTFWriteTest.zip"
llCreated = this.AddFilesToZip(lcZipPath, lcTempZip)
IF llCreated
apiMoveFile(lcTempZip, "E:\My Work\FoxPro\Projects\WorkbookXLSX\Test Spreadsheets\Test\UTFWriteTest.xlsx")
ENDIF
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
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
RETURN llReturn
ENDPROC
PROCEDURE UnGroupByColumn && Removes a data group level by columns
LPARAMETERS tnWB, tnSheet, tnBegCol, tnEndCol
LOCAL lnCol, lnLevel
LOCAL ARRAY laLevel[1]
IF PCOUNT() != 4 .OR. VARTYPE(tnBegCol) != "N" .OR. VARTYPE(tnEndCol) != "N"
RETURN False
ENDIF
SELECT MAX(collevel) FROM xl_columns WHERE BINTOC(workbook)+BINTOC(sheet) = BINTOC(tnWB)+BINTOC(tnSheet) .AND. col >= tnBegCol .AND. col <= tnEndCol INTO ARRAY laLevel
lnLevel = NVL(laLevel[1], 0) - 1
FOR lnCol=tnBegCol TO tnEndCol
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(lnCol), "xl_columns", "col")
REPLACE xl_columns.collevel WITH lnLevel IN xl_columns
ENDIF
ENDFOR
RETURN True
ENDPROC
PROCEDURE UnGroupByRow && Removes a data group level by rows
LPARAMETERS tnWB, tnSheet, tnBegRow, tnEndRow
LOCAL lnRow, lnLevel
LOCAL ARRAY laLevel[1]
IF PCOUNT() != 4 .OR. VARTYPE(tnBegRow) != "N" .OR. VARTYPE(tnEndRow) != "N"
RETURN False
ENDIF
SELECT MAX(rowlevel) FROM xl_rows WHERE BINTOC(workbook)+BINTOC(sheet) = BINTOC(tnWB)+BINTOC(tnSheet) .AND. row >= tnBegRow .AND. row <= tnEndRow INTO ARRAY laLevel
lnLevel = MAX(NVL(laLevel[1], 0) - 1, 0)
FOR lnRow=tnBegRow TO tnEndRow
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(lnRow), "xl_rows", "row")
REPLACE xl_rows.rowlevel WITH lnLevel IN xl_rows
ENDIF
ENDFOR
RETURN True
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, '')
FWRITE(thFile, '')
FWRITE(thFile, '')
FWRITE(thFile, '')
FWRITE(thFile, '')
FWRITE(thFile, '')
FWRITE(thFile, '')
FWRITE(thFile, '' + this.GetXMLString(txCellValue) + '')
FWRITE(thFile, '')
FWRITE(thFile, '')
FWRITE(thFile, '')
ENDPROC
PROTECTED PROCEDURE WriteAsInLineString && Writes the value as an inlineStr value
LPARAMETERS thFile, tnRow, tnCol, txCellValue
FWRITE(thFile, '')
FWRITE(thFile, '' + this.GetXMLString(txCellValue) + '')
FWRITE(thFile, '')
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, '')
FWRITE(thFile, '' + TRANSFORM(MTON(txCellValue)) + '')
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, '')
FWRITE(thFile, '' + TRANSFORM(txCellValue) + '')
OTHERWISE
FWRITE(thFile, '')
FWRITE(thFile, 'Unsupported Field Type')
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, '')
FWRITE(thFile, '' + TRANSFORM(MTON(txCellValue)) + '')
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, '')
FWRITE(thFile, '' + TRANSFORM(txCellValue) + '')
OTHERWISE
FWRITE(thFile, '')
FWRITE(thFile, 'Unsupported Field Type')
ENDCASE
ENDPROC
PROTECTED PROCEDURE WriteDirectXMLs && Writes the workbook XMLs for direct table/grid to workbook output
LPARAMETERS tcPath, taSheetNames, tnNumSheets
LOCAL lhFile, lcFileName, loException, lcSheetName, lnSheet
EXTERNAL ARRAY taSheetNames
*-* Create the supporting XML files
loException = .NULL.
TRY
lhFile = FCREATE(tcPath + "[Content_Types].xml")
IF lhFile =< 0
THROW
ENDIF
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FOR lnSheet=1 TO tnNumSheets
FWRITE(lhFile, '')
ENDFOR
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FCLOSE(lhFile)
*-* Save the .rels XML
lhFile = FCREATE(tcPath + "_rels\.rels")
IF lhFile =< 0
THROW
ENDIF
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FCLOSE(lhFile)
*-* Write the workbook relationships file
lhFile = FCREATE(tcPath + "xl\_rels\workbook.xml.rels")
IF lhFile =< 0
THROW
ENDIF
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FOR lnSheet=1 TO tnNumSheets
FWRITE(lhFile, '')
ENDFOR
FWRITE(lhFile, '')
FCLOSE(lhFile)
*-* Save the app XML
lcFileName = tcPath + "docProps\app.xml"
lhFile = FCREATE(lcFileName)
IF lhFile =< 0
THROW
ENDIF
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, 'ExcelXMLX Release ' + TRANSFORM(this.ExcelXlsxRelease) + '')
IF !EMPTY(this.CompanyName)
FWRITE(lhFile, '' + this.CompanyName + '')
ENDIF
FWRITE(lhFile, '')
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
*-* Save the core XML
lcFileName = tcPath + "docProps\core.xml"
lhFile = FCREATE(lcFileName)
IF lhFile =< 0
THROW
ENDIF
FWRITE(lhFile, '')
FWRITE(lhFile, '')
IF !EMPTY(this.Title)
FWRITE(lhFile, '' + this.GetXMLString(this.Title) + '')
ENDIF
IF !EMPTY(this.Subject)
FWRITE(lhFile, '' + this.GetXMLString(this.Subject) + '')
ENDIF
IF !EMPTY(this.CreatorName)
FWRITE(lhFile, '' + this.GetXMLString(this.CreatorName) + '')
ENDIF
IF !EMPTY(this.UserName)
FWRITE(lhFile, '' + this.GetXMLString(this.UserName) + '')
ENDIF
IF VERSION(5) < 900
FWRITE(lhFile, '' + this.TTOC3(DATETIME()) + 'Z')
FWRITE(lhFile, '' + this.TTOC3(DATETIME()) + 'Z')
ELSE
FWRITE(lhFile, '' + TTOC(DATETIME(), 3) + 'Z')
FWRITE(lhFile, '' + TTOC(DATETIME(), 3) + 'Z')
ENDIF
FWRITE(lhFile, '')
FCLOSE(lhFile)
this.SaveAsUTF8(lcFileName)
*-* Write the workbook XML
lcFileName = tcPath + "xl\workbook.xml"
lhFile = FCREATE(lcFileName)
IF lhFile =< 0
THROW
ENDIF
FWRITE(lhFile, ''+ LF)
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FOR lnSheet=1 TO tnNumSheets
IF EMPTY(taSheetNames[lnSheet])
lcSheetName = "Sheet" + TRANSFORM(lnSheet)
ELSE
lcSheetName = taSheetNames[lnSheet]
ENDIF
FWRITE(lhFile, '')
ENDFOR
FWRITE(lhFile, '')
FWRITE(lhFile, '')
FWRITE(lhFile, '')
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 WriteDrawingDefinitionXML && Writes the drawing definition XML
LPARAMETERS tnWB, tnSheet, tcPath
LOCAL llSuccess, loException, lcFileName, lhDwgFile
loException = .NULL.
llSuccess = True
SELECT * FROM xl_relationships WHERE workbook = tnWB AND sheet = tnSheet AND relsrc = RELS_SRC_DRAWING INTO CURSOR xl_tempdwg
IF _TALLY > 0
TRY
*-* Write the drawing relationships and positioning file
lcFileName = tcPath + "xl\drawings\drawing" + TRANSFORM(tnSheet) + ".xml"
lhDwgFile = FCREATE(lcFileName)
IF lhDwgFile < 0
THROW
ENDIF
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
SELECT xl_tempdwg
SCAN
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(xl_tempdwg.relid), "xl_images", "relid")
DO CASE
CASE xl_images.anchor = IMAGE_ANCHOR_TYPE_ABS
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
CASE xl_images.anchor = IMAGE_ANCHOR_TYPE_ONE
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begcol) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begcoloff) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begrow) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begrowoff) + '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
CASE xl_images.anchor = IMAGE_ANCHOR_TYPE_TWO
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begcol) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begcoloff) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begrow) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.begrowoff) + '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.endcol) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.endcoloff) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.endrow) + '')
FWRITE(lhDwgFile, '' + TRANSFORM(xl_images.endrowoff) + '')
FWRITE(lhDwgFile, '')
ENDCASE
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
FWRITE(lhDwgFile, '')
DO CASE
CASE xl_images.anchor = IMAGE_ANCHOR_TYPE_ABS
FWRITE(lhDwgFile, '')
CASE xl_images.anchor = IMAGE_ANCHOR_TYPE_ONE
FWRITE(lhDwgFile, '')
CASE xl_images.anchor = IMAGE_ANCHOR_TYPE_TWO
FWRITE(lhDwgFile, '')
ENDCASE
ENDIF
ENDSCAN
FWRITE(lhDwgFile, '')
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 16
RAISEEVENT(this, "OnShowErrorMessage", 16, "Unable to create sheet" + TRANSFORM(tnSheet))
FINALLY
IF ISNULL(loException)
FCLOSE(lhDwgFile)
this.SaveAsUTF8(lcFileName)
ENDIF
ENDTRY
ENDIF
USE IN SELECT("xl_tempdwg")
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE WriteImageRelationshipsXML && Writes the image relationship (.rels) xml file
LPARAMETERS tnWB, tnSheet, tcPath
LOCAL llSuccess, loException, lcFileName, lhDwgRels, lcBaseType, lcTgtFile
llSuccess = True
loException = .NULL.
lcBaseType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"
SELECT * FROM xl_relationships WHERE workbook = tnWB AND sheet = tnSheet AND relsrc = RELS_SRC_DRAWING INTO CURSOR xl_tempimg
IF _TALLY > 0
TRY
*-* Write the image relationships file
lcFileName = tcPath + "xl\drawings\_rels\drawing" + TRANSFORM(tnSheet) + ".xml.rels"
lhDwgRels = FCREATE(lcFileName)
IF lhDwgRels < 0
THROW
ENDIF
FWRITE(lhDwgRels, '')
FWRITE(lhDwgRels, '')
SELECT xl_tempimg
SCAN
TRY
lcTgtFile = tcPath + "xl/media/image" + TRANSFORM(xl_tempimg.globalid) + "." + JUSTEXT(ALLTRIM(xl_tempimg.target))
this.ConvertStringToFile(ALLTRIM(xl_tempimg.filecontent), lcTgtFile, 14)
CATCH TO loException
THROW loException.Message
ENDTRY
IF ISNULL(loException)
FWRITE(lhDwgRels, '')
ENDIF
ENDSCAN
FWRITE(lhDwgRels, '')
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 16
RAISEEVENT(this, "OnShowErrorMessage", 16, "Unable to create sheet" + TRANSFORM(tnSheet))
FINALLY
IF ISNULL(loException)
FCLOSE(lhDwgRels)
this.SaveAsUTF8(lcFileName)
ENDIF
ENDTRY
ENDIF
USE IN SELECT("xl_tempimg")
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE WriteSheetRelationshipsXML && Writes the sheet relationships xml file
LPARAMETERS tnWB, tnSheet, tcPath
LOCAL lcBaseType, llSuccess, lhShRels, loException, lcRelsFileName
LOCAL ARRAY laRecord[1]
llSuccess = True
loException = .NULL.
lcBaseType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/"
SELECT * FROM xl_relationships WHERE workbook = tnWB AND sheet = tnSheet AND relsrc = RELS_SRC_SHEET INTO CURSOR xl_tempsh
IF _TALLY > 0
TRY
*-* Write the sheet relationships file
lcRelsFileName = tcPath + "xl\worksheets\_rels\sheet" + TRANSFORM(tnSheet) + ".xml.rels"
lhShRels = FCREATE(lcRelsFileName)
IF lhShRels < 0
THROW
ENDIF
FWRITE(lhShRels, '')
FWRITE(lhShRels, '')
SELECT xl_tempsh
SCAN
FWRITE(lhShRels, '')
ENDSCAN
FWRITE(lhShRels, '')
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 16
RAISEEVENT(this, "OnShowErrorMessage", 16, "Unable to create sheet" + TRANSFORM(tnSheet) + " Relationships file")
FINALLY
IF ISNULL(loException)
FCLOSE(lhShRels)
this.SaveAsUTF8(lcRelsFileName)
ENDIF
ENDTRY
llSuccess = this.WriteDrawingDefinitionXML(tnWB, tnSheet, tcPath)
SELECT relid FROM xl_relationships WHERE workbook = tnWB AND sheet = tnSheet AND reltype = RELS_TYPE_IMAGE INTO ARRAY laRecord
IF llSuccess .AND. VARTYPE(laRecord[1]) = "N"
llSuccess = this.WriteImageRelationshipsXML(tnWB, tnSheet, tcPath)
ENDIF
ELSE
llSuccess = True
ENDIF
USE IN SELECT("xl_tempsh")
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE WriteSheetXMLs && Writes the Sheet XML files
LPARAMETERS tnWB, tnSheet, tcPath
LOCAL llSuccess, lcAlias, lhShFile, lcRow, lnMinCol, lnWidth, lcDyDescent
LOCAL lcRowDefHt, lcFileName, lcRelsFileName, lhRels, lcValidationText, lcSqRef, lnValidCnt, lcStyle
LOCAL lnHeadRow, lcColumn, lcOddText, lcEvenText, lcSameText, lcHeaderText, lcFooterText, lcFirstHdrText
LOCAL lcFirstFtrText, loException, lcRange, lnLastCol, lcCellFormula, lcMaxCol
LOCAL ARRAY laRecord[1], laRelId[1], laMaxCol[1]
*-* Write the sheet XML
lcAlias = ALIAS()
*-* Write the sheet
loException = .NULL.
TRY
lcFileName = tcPath + "xl\worksheets\sheet" + TRANSFORM(tnSheet) + ".xml"
lhShFile = FCREATE(lcFileName)
IF lhShFile <= 0
THROW
ENDIF
lcDyDescent = ''
* lcDyDescent = ' x14ac:dyDescent="0.25"' && Uncomment to add back...
*-* Write sheet XML header information
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
*-* Write the tab color definition if set and sheet outline settings
FWRITE(lhShFile, '')
DO CASE
CASE xl_sheets.tabcolorndx > 0
FWRITE(lhShFile, '')
CASE !EMPTY(xl_sheets.tabcolorrgb)
FWRITE(lhShFile, '')
ENDCASE
* FWRITE(lhShFile, '') && If uncommented; sheet will be invalid by Excel
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
*-* Verify cells have been written
SELECT xl_cells
LOCATE FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSheet .AND. !xl_cells.celldeleted
IF FOUND()
*-* Write the sheet view information which includes the freeze pane information
SELECT cel.sheet, MAX(cel.cellcol), MAX(cel.cellrow) ;
FROM xl_cells AS cel ;
WHERE cel.workbook = tnWB ;
AND cel.sheet = tnSheet ;
AND cel.celldeleted = False ;
GROUP BY 1 ;
INTO ARRAY laRecord
FWRITE(lhShFile, '')
FWRITE(lhShFile, ' 0
FWRITE(lhShFile, ' tabSelected="' + TRANSFORM(xl_sheets.tabselctd) + '"')
ENDIF
IF xl_sheets.zoomscale > 0
FWRITE(lhShFile, ' zoomScale="' + TRANSFORM(xl_sheets.zoomscale) + '" zoomScaleNormal="' + TRANSFORM(xl_sheets.zoomscale) + '"')
ENDIF
FWRITE(lhShFile, '>')
DO CASE
CASE xl_sheets.ysplit > 0 .AND. xl_sheets.xsplit = 0 && Freeze top row(s) only
lcRow = TRANSFORM(xl_sheets.ysplit+1)
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
CASE xl_sheets.ysplit = 0 .AND. xl_sheets.xsplit > 0 && Freeze side column(s) only
lcColumn = this.ColumnIndexToAscii(xl_sheets.xsplit+1)
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
CASE xl_sheets.ysplit > 0 .AND. xl_sheets.xsplit > 0 && Freeze both top row(s) and side column(s)
lcRow = TRANSFORM(xl_sheets.ysplit+1)
lcColumn = this.ColumnIndexToAscii(xl_sheets.xsplit+1)
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
OTHERWISE
IF EMPTY(xl_sheets.activcell)
FWRITE(lhShFile, '')
ELSE
FWRITE(lhShFile, '')
ENDIF
ENDCASE
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
*-* Write sheet Column widths
SELECT xl_columns
LOCATE FOR xl_columns.workbook = tnWB .AND. xl_columns.sheet = tnSheet
IF FOUND()
FWRITE(lhShFile, '')
SET ORDER TO TAG col
SET FILTER TO xl_columns.workbook = tnWB .AND. xl_columns.sheet = tnSheet
GOTO TOP IN xl_columns
lcColMin = TRANSFORM(xl_columns.col)
lnColLevel = xl_columns.collevel
lnColHiddn = xl_columns.hidden
lnColWidth = xl_columns.width
DO WHILE .NOT. EOF('xl_columns')
lcColMax = TRANSFORM(xl_columns.col)
SKIP 1 IN xl_columns
IF xl_columns.collevel != lnColLevel .OR. xl_columns.hidden != lnColHiddn .OR. xl_columns.width != lnColWidth
FWRITE(lhShFile, ' -1.00 .AND. lnColLevel = 0 .AND. lnColHiddn = 0
FWRITE(lhShFile, ' width="' + TRANSFORM(lnColWidth+0.7109375) + '" customWidth="1"/>')
CASE lnColWidth > -1.00 .AND. lnColLevel = 0 .AND. lnColHiddn = 1
FWRITE(lhShFile, ' width="' + TRANSFORM(lnColWidth+0.7109375) + '" hidden="1" customWidth="1"/>')
CASE lnColWidth = -1.00 .AND. lnColLevel > 0
FWRITE(lhShFile, ' outlineLevel="' + TRANSFORM(lnColLevel) + '"/>')
CASE lnColWidth > -1.00 .AND. lnColLevel > 0
FWRITE(lhShFile, ' width="' + TRANSFORM(lnColWidth+0.7109375) + '" customWidth="1" outlineLevel="' + TRANSFORM(lnColLevel) + '"/>')
OTHERWISE
FWRITE(lhShFile, '/>')
ENDCASE
lcColMin = TRANSFORM(xl_columns.col)
lnColLevel = xl_columns.collevel
lnColHiddn = xl_columns.hidden
lnColWidth = xl_columns.width
ENDIF
ENDDO
SET FILTER TO
SET ORDER TO
FWRITE(lhShFile, '')
ENDIF
*-* Write sheet cell data values by row/column
FWRITE(lhShFile, '')
SELECT xl_cells
SET ORDER TO TAG cellindex
SELECT xl_rows
SET ORDER TO TAG row
SCAN FOR xl_rows.workbook = tnWB .AND. xl_rows.sheet = tnSheet .AND. xl_rows.row > 0
FWRITE(lhShFile, ' 0
FWRITE(lhShFile, ' hidden="1"')
ENDIF
DO CASE
CASE xl_rows.height > -1.00 .AND. xl_rows.rowlevel = 0
FWRITE(lhShFile, ' ht="' + TRANSFORM(xl_rows.height) + '" customHeight="1">')
CASE xl_rows.height = -1.00 .AND. xl_rows.rowlevel > 0
FWRITE(lhShFile, ' outlineLevel="' + TRANSFORM(xl_rows.rowlevel) + '" collapsed="1">')
CASE xl_rows.height > -1.00 .AND. xl_rows.rowlevel > 0
FWRITE(lhShFile, ' ht="' + TRANSFORM(xl_rows.height) + '" customHeight="1" outlineLevel="' + TRANSFORM(xl_rows.rowlevel) + '" collapsed="1">')
OTHERWISE
IF this.AutoHeight && Suggestion for Autoheight from Cesar Chalom
lcRowDefHt = ' ht="' + TRANSFORM(this.GetRowMaxFontSize(tnWB, tnSheet, xl_rows.row) * 1.4) + '"'
ELSE
lcRowDefHt = ' ht="30"'
ENDIF
FWRITE(lhShFile, lcRowDefHt + '>')
ENDCASE
SELECT xl_cells
SCAN FOR xl_cells.workbook = tnWB .AND. xl_cells.sheet = tnSheet .AND. xl_cells.cellrow = xl_rows.row
IF xl_cells.cellxfs > 0
lcStyle = ' s="' + TRANSFORM(xl_cells.cellxfs) + '"'
ELSE
lcStyle = ''
ENDIF
DO CASE
CASE xl_cells.datatype = DATA_TYPE_TIME
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
CASE xl_cells.datatype = DATA_TYPE_DATE
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
CASE xl_cells.datatype = DATA_TYPE_DATETIME
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
CASE xl_cells.datatype = DATA_TYPE_LOGICAL
FWRITE(lhShFile, ' -1
FWRITE(lhShFile, ' t="s">' + TRANSFORM(xl_cells.stringid) + '')
ELSE
FWRITE(lhShFile, ' t="inlineStr">' + this.GetXMLString(ALLTRIM(xl_cells.cellvalue)) + '')
ENDIF
CASE xl_cells.datatype = DATA_TYPE_CHAR
FWRITE(lhShFile, ' -1
FWRITE(lhShFile, ' t="s">' + TRANSFORM(xl_cells.stringid) + '')
ELSE
FWRITE(lhShFile, ' t="inlineStr">' + this.GetXMLString(ALLTRIM(xl_cells.cellvalue)) + '')
ENDIF
CASE xl_cells.datatype = DATA_TYPE_INT
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
CASE xl_cells.datatype = DATA_TYPE_FLOAT
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
CASE xl_cells.datatype = DATA_TYPE_CURRENCY
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
CASE xl_cells.datatype = DATA_TYPE_PERCENT
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
CASE xl_cells.datatype = DATA_TYPE_FORMULA
FWRITE(lhShFile, '')
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet)+BINTOC(xl_cells.cellrow)+BINTOC(xl_cells.cellcol), "xl_formulas", "cell")
lcCellFormula = this.GetXMLString(ALLTRIM(xl_formulas.cellformula))
DO CASE
CASE xl_formulas.formulatype = "shared"
FWRITE(lhShFile, '' + lcCellFormula + '')
CASE xl_formulas.formulatype = "array"
FWRITE(lhShFile, '' + lcCellFormula + '')
CASE xl_formulas.formulatype = "dataTable"
OTHERWISE
FWRITE(lhShFile, '' + lcCellFormula + '')
ENDCASE
ELSE
DO CASE
CASE xl_cells.formulatype = "shared"
FWRITE(lhShFile, '')
CASE xl_cells.formulatype = "array"
CASE xl_cells.formulatype = "dataTable"
ENDCASE
ENDIF
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
FWRITE(lhShFile, '')
CASE xl_cells.datatype = DATA_TYPE_TEXT
FWRITE(lhShFile, '')
FWRITE(lhShFile, '' + ALLTRIM(xl_cells.cellvalue) + '')
FWRITE(lhShFile, '')
CASE xl_cells.datatype = DATA_TYPE_NONE
IF !EMPTY(lcStyle)
FWRITE(lhShFile, '')
ENDIF
ENDCASE
ENDSCAN
FWRITE(lhShFile, '
')
ENDSCAN
FWRITE(lhShFile, '')
SELECT xl_cells
SET ORDER TO
SELECT xl_rows
SET ORDER TO
ELSE
*-* No cell data has been created/written
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
ENDIF
*-* Write sheet protection data
IF xl_sheets.protection
FWRITE(lhShFile, '')
ENDIF
*-* Write the column filter if assigned
IF xl_sheets.addfilter
lcRange = this.ColumnIndexToAscii(xl_sheets.filtbegcol) + "1:" + this.ColumnIndexToAscii(xl_sheets.filtendcol) + TRANSFORM(NVL(laRecord[1, 3], 1))
FWRITE(lhShFile, '')
SELECT col, filtoper, filtvalue FROM xl_filters WHERE workbook = tnWB AND sheet = tnSheet ORDER BY col INTO CURSOR tmp_filter
SELECT DISTINCT col, andoperator FROM xl_filters WHERE workbook = tnWB AND sheet = tnSheet ORDER BY col INTO CURSOR tmp_columns
SELECT tmp_columns
SCAN
FWRITE(lhShFile, '')
FWRITE(lhShFile, '', '>'))
SELECT tmp_filter
SCAN FOR tmp_filter.col = tmp_columns.col
FWRITE(lhShFile, '')
ENDSCAN
FWRITE(lhShFile, '')
FWRITE(lhShFile, '')
ENDSCAN
USE IN SELECT('tmp_filter')
USE IN SELECT('tmp_columns')
FWRITE(lhShFile, '')
ELSE
FWRITE(lhShFile, '/>')
ENDIF
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 = tnSheet ;
ORDER BY mrg.begrow ;
INTO CURSOR t_merge
IF _TALLY > 0
FWRITE(lhShFile, '')
SELECT t_merge
SCAN
FWRITE(lhShFile, '')
ENDSCAN
FWRITE(lhShFile, '')
ENDIF
USE IN t_merge
*-* Write the cell validation data
SELECT xl_validation
COUNT FOR xl_validation.workbook = tnWB .AND. xl_validation.sheet = tnSheet .AND. !DELETED() TO lnValidCnt
IF lnValidCnt > 0
FWRITE(lhShFile, '')
SCAN
SELECT xl.cellrow, xl.cellcol FROM xl_cells AS xl ;
WHERE BINTOC(xl.workbook)+BINTOC(xl.sheet)+BINTOC(xl.validndx) = BINTOC(tnWB)+BINTOC(tnSheet)+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(lhShFile, '')
IF xl_validation.formula
FWRITE(lhShFile, '' + ALLTRIM(xl_validation.formula1) + '')
IF !EMPTY(xl_validation.formula2)
FWRITE(lhShFile, '' + ALLTRIM(xl_validation.formula2) + '')
ENDIF
ELSE
FWRITE(lhShFile, '"' + ALLTRIM(xl_validation.formula1) + '"')
IF !EMPTY(xl_validation.formula2)
FWRITE(lhShFile, '"' + ALLTRIM(xl_validation.formula2) + '"')
ENDIF
ENDIF
FWRITE(lhShFile, '')
ENDSCAN
USE IN SELECT('t_celllist')
FWRITE(lhShFile, '')
ENDIF
*-* Write sheet hyperlink data
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet), "xl_hyperlinks", "sheet")
FWRITE(lhShFile, '')
SELECT xl_hyperlinks
SCAN FOR workbook = tnWB .AND. sheet = tnSheet
FWRITE(lhShFile, '')
ELSE
lcSheetName = this.GetSheetName(tnWB, xl_hyperlinks.tgtsheet)
IF EMPTY(lcSheetName)
lcTarget = "'Sheet" + TRANSFORM(xl_hyperlinks.tgtsheet) + "'!"
ELSE
lcTarget = "'" + lcSheetName + "'!"
ENDIF
lcTarget = lcTarget + this.ColumnIndexToAscii(xl_hyperlinks.tgtBegCol) + TRANSFORM(xl_hyperlinks.tgtBegRow)
lcTarget = lcTarget + ":"
lcTarget = lcTarget + this.ColumnIndexToAscii(xl_hyperlinks.tgtEndCol) + TRANSFORM(xl_hyperlinks.tgtEndRow)
FWRITE(lhShFile, ' location="' + lcTarget + '" display="' + this.GetXMLString(ALLTRIM(xl_hyperlinks.display)) + '"/>')
ENDIF
ENDSCAN
FWRITE(lhShFile, '')
ENDIF
*-* Write sheet print options
IF xl_sheets.prnopthead > 0 .OR. xl_sheets.prnoptgrid > 0 .OR. xl_sheets.prnoptctrv > 0 .OR. xl_sheets.prnoptctrh > 0
FWRITE(lhShFile, ' 0
FWRITE(lhShFile, ' headings="' + TRANSFORM(xl_sheets.prnopthead) + '"')
ENDIF
IF xl_sheets.prnoptgrid > 0
FWRITE(lhShFile, ' gridLines="' + TRANSFORM(xl_sheets.prnoptgrid) + '"')
ENDIF
IF xl_sheets.prnoptctrv > 0
FWRITE(lhShFile, ' verticalCentered="' + TRANSFORM(xl_sheets.prnoptctrv) + '"')
ENDIF
IF xl_sheets.prnoptctrh > 0
FWRITE(lhShFile, ' horizontalCentered="' + TRANSFORM(xl_sheets.prnoptctrh) + '"')
ENDIF
FWRITE(lhShFile, '/>')
ENDIF
*-* Write sheet margin data
FWRITE(lhShFile, '')
*-* Write the sheet page print setup
FWRITE(lhShFile, ' 0 .AND. xl_sheets.paperheight > 0
FWRITE(lhShFile, ' paperHeight="' + TRANSFORM(xl_sheets.paperheight) + xl_sheets.paperdimen + '"')
FWRITE(lhShFile, ' paperWidth="' + TRANSFORM(xl_sheets.paperwidth) + xl_sheets.paperdimen + '"')
ELSE
IF xl_sheets.papersize > 0
FWRITE(lhShFile, ' paperSize="' + TRANSFORM(xl_sheets.papersize) + '"')
ENDIF
ENDIF
DO CASE
CASE xl_sheets.fittowidth > 0 .AND. xl_sheets.fittoheight > 0
FWRITE(lhShFile, ' fitToWidth="' + TRANSFORM(xl_sheets.fittowidth) + '"')
FWRITE(lhShFile, ' fitToHeight="' + TRANSFORM(xl_sheets.fittoheight) + '"')
CASE xl_sheets.fittowidth = 0 .AND. xl_sheets.fittoheight > 0
FWRITE(lhShFile, ' fitToHeight="' + TRANSFORM(xl_sheets.fittoheight) + '"')
CASE xl_sheets.fittowidth > 0 .AND. xl_sheets.fittoheight = 0
FWRITE(lhShFile, ' fitToWidth="' + TRANSFORM(xl_sheets.fittowidth) + '"')
OTHERWISE
IF xl_sheets.scale != 100
FWRITE(lhShFile, ' scale="' + TRANSFORM(xl_sheets.scale) + '"')
ENDIF
ENDCASE
FWRITE(lhShFile, '/>')
*-* Write the header and footer for the sheet if defined
IF SEEK(BINTOC(tnWB)+BINTOC(tnSheet), "xl_hdrfooterdefn", "wbsheet")
FWRITE(lhShFile, '')
*-* Get the page header text
lcOddText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '', lcOddText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '', lcOddText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '', lcOddText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcOddText)
lcOddText = lcOddText + ''
ENDIF
lcEvenText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '', lcEvenText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '', lcEvenText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '', lcEvenText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcEvenText)
lcEvenText = lcEvenText + ''
ENDIF
lcSameText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '', lcSameText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '', lcSameText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '', lcSameText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcSameText)
lcSameText = lcSameText + ''
ENDIF
IF EMPTY(lcSameText)
lcHeaderText = lcOddText + lcEvenText
ELSE
lcHeaderText = lcSameText
ENDIF
*-* Get the page footer text
lcOddText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '', lcOddText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '', lcOddText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_ODD_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcOddText = IIF(EMPTY(lcOddText), '', lcOddText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcOddText)
lcOddText = lcOddText + ''
ENDIF
lcEvenText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '', lcEvenText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '', lcEvenText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_EVEN_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcEvenText = IIF(EMPTY(lcEvenText), '', lcEvenText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcEvenText)
lcEvenText = lcEvenText + ''
ENDIF
lcSameText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '', lcSameText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '', lcSameText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_SAME_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcSameText = IIF(EMPTY(lcSameText), '', lcSameText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcSameText)
lcSameText = lcSameText + ''
ENDIF
IF EMPTY(lcSameText)
lcFooterText = lcOddText + lcEvenText
ELSE
lcFooterText = lcSameText
ENDIF
*-* Get the first page text
lcFirstHdrText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_HDR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcFirstHdrText = IIF(EMPTY(lcFirstHdrText), '', lcFirstHdrText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_HDR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcFirstHdrText = IIF(EMPTY(lcFirstHdrText), '', lcFirstHdrText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_HDR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcFirstHdrText = IIF(EMPTY(lcFirstHdrText), '', lcFirstHdrText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcFirstHdrText)
lcFirstHdrText = lcFirstHdrText + ''
ENDIF
lcFirstFtrText = ""
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_FTR_LEFT), "xl_hdrfootertext", "hdrfootr")
lcFirstFtrText = IIF(EMPTY(lcFirstFtrText), '', lcFirstFtrText) + '&L&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_FTR_CENTER), "xl_hdrfootertext", "hdrfootr")
lcFirstFtrText = IIF(EMPTY(lcFirstFtrText), '', lcFirstFtrText) + '&C&' + this.GetXMLHeaderFooterText()
ENDIF
IF SEEK(this.GetHeaderFooterKeyExpr(tnWB, tnSheet, HEADERFOOTER_FIRST_PAGE, HEADERFOOTER_SECT_FTR_RIGHT), "xl_hdrfootertext", "hdrfootr")
lcFirstFtrText = IIF(EMPTY(lcFirstFtrText), '', lcFirstFtrText) + '&R&' + this.GetXMLHeaderFooterText()
ENDIF
IF !EMPTY(lcFirstFtrText)
lcFirstFtrText = lcFirstFtrText + ''
ENDIF
*-* Write the header/footer text to XML
FWRITE(lhShFile, lcHeaderText + lcFooterText + lcFirstHdrText + lcFirstFtrText + '')
ENDIF
*-* Write the drawing section
SELECT relid FROM xl_relationships WHERE workbook = tnWB AND sheet = tnSheet AND reltype = RELS_TYPE_DRAWING INTO ARRAY laRelId
IF VARTYPE(laRelId[1]) = "N"
FWRITE(lhShFile, '')
ENDIF
FWRITE(lhShFile, '')
llSuccess = True
*-* Write the sheet relationship file
IF !this.WriteSheetRelationshipsXML(tnWB, tnSheet, tcPath)
THROW
ENDIF
CATCH TO loException
SET STEP ON
llSuccess = False
this.ErrorLevelId = 14
RAISEEVENT(this, "OnShowErrorMessage", 14, loException.message)
FINALLY
FCLOSE(lhShFile)
IF ISNULL(loException)
this.SaveAsUTF8(lcFileName)
ENDIF
ENDTRY
IF !EMPTY(lcAlias)
SELECT &lcAlias
ENDIF
RETURN llSuccess
ENDPROC
PROTECTED PROCEDURE WriteStringsXML && Writes the sharedStrings XML
LPARAMETERS tnWB, tcPath, tnTotStrCnt, tnUnqStrCnt
LOCAL lcFileName, lhFile, loException, llSuccess, lnRelId
RAISEEVENT(this, "OnShowStatusMessage", 2, 2)
TRY
*-* Output the file
lcFileName = tcPath + "xl\sharedStrings.xml"
lhFile = FCREATE(lcFileName)
IF lhFile < 0
THROW
ENDIF
FWRITE(lhFile, '' + LF)
FWRITE(lhFile, '') && Change 19Jun2018: missplaced >
SELECT xl_strings
SCAN FOR workbook = tnWB .AND. !DELETED()
IF xl_strings.formatted
FWRITE(lhFile, '')
SELECT xl_strformat
SCAN FOR workbook = tnWB .AND. id = xl_strings.id .AND. !DELETED()
FWRITE(lhFile, '')
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, '')
IF xl_strformat.fbold
FWRITE(lhFile, '')
ENDIF
IF xl_strformat.fitalic
FWRITE(lhFile, '')
ENDIF
IF xl_strformat.uline != UNDERLINE_NONE
FWRITE(lhFile, '')
ENDIF
IF xl_strformat.strkthr
FWRITE(lhFile, '