More Excel
Posted: Wed Dec 19, 2012 5:44 am
I prefer to learn by doing, rather than just reading. It's within that spirit that I used code posted to the forums, then 'took it apart', then pieced it back together while making some not so subtle changes. I prefer not to send strings to procedure, and to do as much as possible in memory, then write the result. I'm not saying this is better, worse or indifferent, it's just a style that happens to work for me.
One thing I could not get to work was colors. If anyone has any information on that, I would be appreciative!
Rich
excel.pbi
excel_test.pb
One thing I could not get to work was colors. If anyone has any information on that, I would be appreciative!
Rich
excel.pbi
Code: Select all
;Excel.pbi - Include file for BIFF 2.1 specifications to write Excel files.
;
;Converted from VB source to PowerBasic, November 2001.
;Paul Squires (2001) support@planetsquires.com (Freeware)
;
;Copyright (c) 2001 by Paul Squires.
;Although this code is available for free, the author retains the copyright, which means that you
;cannot do anything with it that is not expressly allowed by the author. In general terms, the author
;would allow the programmer to incorporate the code into their applications. Selling the code by
;itself is prohibited.
;
;Class file for writing Microsoft Excel BIFF 2.1 files.
;
;Paul Squires, November 10, 2001
;support@planetsquires.com
; constants to hold cell alignment
#xlsGeneralAlign = 0
#xlsLeftAlign = 1
#xlsCenterAlign = 2
#xlsRightAlign = 3
#xlsFillCell = 4
#xlsLeftBorder = 8
#xlsRightBorder = 16
#xlsTopBorder = 32
#xlsBottomBorder = 64
#xlsShaded = 128
; constants to handle selecting the font for the cell, used by rgbAttr2
; bits 0-5 handle the *picture* formatting, not bold/underline etc...
; bits 6-7 handle the font number
#xlsFont0 = 0
#xlsFont1 = 64
#xlsFont2 = 128
#xlsFont3 = 192
#dblQuote = Chr(34)
; used by rgbAttr1
; bits 0-5 must be zero
; bit 6 locked/unlocked
; bit 7 hidden/not hidden
#xlsCellNormal = 0
#xlsCellLocked = 64
#xlsCellHidden = 128
; set up variables to hold the spreadsheet;s layout
#xlsLeftMargin = 38
#xlsRightMargin = 39
#xlsTopMargin = 40
#xlsBottomMargin = 41
; add these enums together. For example: xlsBold + xlsUnderline
#xlsNoFormat = 0
#xlsBold = 1
#xlsItalic = 2
#xlsUnderline = 4
#xlsStrikeout = 8
; colors
#color_builtin_black = $0000
#color_builtin_white = $0001
#color_builtin_red = $0002
#color_builtin_green = $0003
#color_builtin_blue = $0004
#color_builtin_yellow = $0005
#color_builtin_magenta = $0006
#color_builtin_cyan = $0007
#color_black = $0008
#color_white = $0009
#color_red = $000a
#color_lime = $000b
#color_blue = $000c
#color_yellow = $000d
#color_magenta = $000e
#color_cyan = $000f
#color_brown = $0010
#color_green = $0011
#color_navy = $0012
#color_silver = $0016
#color_gray = $0017
#color_orange = $001d
#color_purple = $0024
#color_border = $0040
#color_pattern_bg = $0041
#color_dialog_bg = $0043
#color_chart_text = $004d
#color_chart_bg = $004e
#color_chart_border = $004f
#color_tooltip_bg = $0050
#color_tooltip_text = $0051
#color_text = $7fff
Structure FONT_RECORD
opcode.w ; 49
length.w ; 5 + len(fontName)
fontHeight.w
fontAttributes1.b ; bit0 bold, bit1 italic, bit2 underline, bit3 strikeout, bit4-7 reserved
fontAttributes2.b ; reserved - always 0
fontNameLength.b
EndStructure
Structure PASSWORD_RECORD
opcode.w ; 47
length.w ; len(password)
EndStructure
Structure HEADER_FOOTER_RECORD
opcode.w ; 20 Header, 21 Footer
length.w ; 1 + len(text)
textLength.b
EndStructure
Structure PROTECT_SPREADSHEET_RECORD
opcode.w ; 18
length.w ; 2
protect.w
EndStructure
Structure FORMAT_COUNT_RECORD
opcode.w ; 1f
length.w ; 2
countNum.w
EndStructure
Structure FORMAT_RECORD
opcode.w ; 1e
length.w ; 1 + len(format)
formatLength.b ; len(format)
EndStructure
Structure COLWIDTH_RECORD
opcode.w ; 36
length.w ; 4
colOne.b ; first column
colTwo.b ; last column
columnWidth.w ; at 1/256th of a character
EndStructure
Structure BEG_FILE_RECORD
opcode.w
length.w
version.w
ftype.w
EndStructure
Structure END_FILE_RECORD
opcode.w
length.w
EndStructure
Structure PRINT_GRIDLINES_RECORD
opcode.w
length.w
printFlag.w
EndStructure
Structure TYPE_INTEGER ; Integer record
opcode.w
length.w
rowNumber.w ; unsigned integer
colNumber.w ; unsigned integer
rgbAttr1.b ; rgbAttr1 handles whether cell is hidden and/or locked
rgbAttr2.b ; rgbAttr2 handles the Font# and Formatting assigned to this cell
rgbAttr3.b ; rgbAttr3 handles the Cell Alignment/borders/shading
intValue.w ; the actual integer value
EndStructure
Structure TYPE_NUMBER ; real number
opcode.w
length.w
rowNumber.w ; unsigned integer
colNumber.w ; unsigned integer
rgbAttr1.b ; rgbAttr1 handles whether cell is hidden and/or locked
rgbAttr2.b ; rgbAttr2 handles the Font# and Formatting assigned to this cell
rgbAttr3.b ; rgbAttr3 handles the Cell Alignment/borders/shading
numberValue.d ; 8 Bytes
EndStructure
Structure TYPE_TEXT ; text data
opcode.w
length.w
rowNumber.w ; unsigned integer
colNumber.w ; unsigned integer
rgbAttr1.b ; rgbAttr1 handles whether cell is hidden and/or locked
rgbAttr2.b ; rgbAttr2 handles the Font# and Formatting assigned to this cell
rgbAttr3.b ; rgbAttr3 handles the Cell Alignment/borders/shading
textLength.b ; then length of the text
EndStructure
Structure MARGIN_RECORD_LAYOUT
opcode.w
length.w
marginValue.d ; 8 bytes
EndStructure
Structure HPAGE_BREAK_RECORD
opcode.w
length.w
numPageBreaks.w
EndStructure
Structure DEF_ROWHEIGHT_RECORD
opcode.w
length.w
rowHeight.w
EndStructure
Structure ROW_HEIGHT_RECORD
opcode.w ; 08
length.w ; should always be 16 bytes
rowNumber.w
firstColumn.w
lastColumn.w
rowHeight.w ; written to file as 1/20ths of a point
internal.w
defaultAttributes.b; set to zero for no default attributes
fileOffset.w
rgbAttr1.b
rgbAttr2.b
rgbAttr3.b
EndStructure
Global Dim xlsHorizPageBreakRows.w(0); create an array that will hold the rows where a horizontal page
Global xlsNumHorizPageBreaks.i = 0
Declare.i xlsBeginFile(*memArea)
Declare.i xlsCloseFile(*memArea)
Declare.i xlsInsertHorizPageBreak(rowNumber.i)
Declare.i xlsWriteInteger(*memArea, value.i, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Declare.i xlsWriteNumber(*memArea, value.d, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Declare.i xlsWriteText(*memArea, *value, lenVal.i, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Declare.i xlsWriteDate(*memArea, *dateString, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Declare.i xlsSetMargin(*memArea, margin.i, marginValue.i)
Declare.i xlsSetColumnWidth(*memArea, firstColumn.i, lastColumn.i, widthValue.i)
Declare.i xlsSetFont(*memArea, *fontName, lenVal.i, fontHeight.i, fontFormat.i)
Declare.i xlsSetHeader(*memArea, *headerText, lenVal.i)
Declare.i xlsSetFooter(*memArea, *footerText, lenVal.i)
Declare.i xlsSetFilePassword(*memArea, *passwordText, lenVal.i)
Declare.i xlsPrintGridLines(*memArea, trueFalse.i)
Declare.i xlsProtectSpreadsheet(*memArea, trueFalse.i)
Declare.i xlsWriteDefaultFormats(*memArea)
Declare.i xlsSetDefaultRowHeight(*memArea, heightValue.i)
Declare.i xlsSetRowHeight(*memArea, rowNumber.i, heightValue.i)
Declare.i convertRow(rowNumber.i)
Declare.i convertCol(colNumber.i)
Declare.d convertDate(*dateString)
; **********************************************************************************
; create the beginning of the xls file
; **********************************************************************************
Procedure.i xlsBeginFile(*memArea)
Protected BEG_FILE_MARKER.BEG_FILE_RECORD
Protected memLength.i
BEG_FILE_MARKER\opcode = 9
BEG_FILE_MARKER\length = 4
BEG_FILE_MARKER\version = 2
BEG_FILE_MARKER\ftype = 10
CopyMemory(@BEG_FILE_MARKER, *memArea, SizeOf(BEG_FILE_MARKER))
memLength = SizeOf(BEG_FILE_MARKER)
memLength = memLength + xlsWriteDefaultFormats(*memArea + memLength)
; create the Horizontal Page Break array
ReDim xlsHorizPageBreakRows(0)
xlsNumHorizPageBreaks = 0
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; create the end of the xls file
; **********************************************************************************
Procedure.i xlsCloseFile(*memArea)
Protected HORIZ_PAGE_BREAK.HPAGE_BREAK_RECORD
Protected END_FILE_MARKER.END_FILE_RECORD
Protected memLength.i = 0
Protected pageBreak.w
Protected pbIndex.i
; write the horizontal page breaks if necessary
If xlsNumHorizPageBreaks > 0
SortArray(xlsHorizPageBreakRows(), #PB_Sort_Ascending)
; write the Horizontal Page Break Record
HORIZ_PAGE_BREAK\opcode = 27
HORIZ_PAGE_BREAK\length = 2 + (xlsNumHorizPageBreaks * 2)
HORIZ_PAGE_BREAK\numPageBreaks = xlsNumHorizPageBreaks
CopyMemory(@HORIZ_PAGE_BREAK, *memArea, SizeOf(HORIZ_PAGE_BREAK))
memLength = SizeOf(HORIZ_PAGE_BREAK)
; now write the actual page break values
For pbIndex=1 To xlsNumHorizPageBreaks
pageBreak = xlsHorizPageBreakRows(pbIndex)
CopyMemory(@pageBreak, *memArea + memLength, SizeOf(pageBreak))
memLength = memLength + SizeOf(pageBreak)
Next
EndIf
; end of file marker
END_FILE_MARKER\opcode = 10
CopyMemory(@END_FILE_MARKER, *memArea + memLength, SizeOf(END_FILE_MARKER))
memLength = memLength + SizeOf(END_FILE_MARKER)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; insert a horizontal page break
; **********************************************************************************
Procedure.i xlsInsertHorizPageBreak(rowNumber.i)
rowNumber = convertRow(rowNumber)
xlsNumHorizPageBreaks = xlsNumHorizPageBreaks + 1
ReDim xlsHorizPageBreakRows(xlsNumHorizPageBreaks)
xlsHorizPageBreakRows(xlsNumHorizPageBreaks) = rowNumber
EndProcedure
; **********************************************************************************
; make sure the row is in word format
; **********************************************************************************
Procedure.i convertRow(rowNumber.i)
; the row and column values are written to the excel file as unsigned integers. Therefore, we must convert the longs to integer.
If rowNumber > 32767
ProcedureReturn rowNumber - 65536
Else
ProcedureReturn rowNumber - 1 ; rows/cols in Excel binary file are base zero
EndIf
EndProcedure
; **********************************************************************************
; make sure the column is in word format
; **********************************************************************************
Procedure.i convertCol(colNumber.i)
; the row and column values are written to the excel file as unsigned integers. Therefore, we must convert the longs to integer.
If colNumber > 32767
ProcedureReturn colNumber - 65536
Else
ProcedureReturn colNumber - 1 ; rows/cols in Excel binary file are base zero
EndIf
EndProcedure
; **********************************************************************************
; write out an integer value
; **********************************************************************************
Procedure.i xlsWriteInteger(*memArea, value.i, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Protected INTEGER_RECORD.TYPE_INTEGER
Protected memLength.i
; convert the row, col from LONG to INTEGER.
rowNumber = convertRow(rowNumber)
colNumber = convertCol(colNumber)
INTEGER_RECORD\opcode = 2
INTEGER_RECORD\length = 9
INTEGER_RECORD\rowNumber = rowNumber
INTEGER_RECORD\colNumber = colNumber
INTEGER_RECORD\rgbAttr1 = hiddenLocked
INTEGER_RECORD\rgbAttr2 = cellFont + cellFormat
INTEGER_RECORD\rgbAttr3 = cellAlignment
INTEGER_RECORD\intValue = value
CopyMemory(@INTEGER_RECORD, *memArea, SizeOf(INTEGER_RECORD))
memLength = SizeOf(INTEGER_RECORD)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out a real number value
; **********************************************************************************
Procedure.i xlsWriteNumber(*memArea, value.d, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Protected NUMBER_RECORD.TYPE_NUMBER
Protected memLength.i
; convert the row, col from LONG to INTEGER.
rowNumber = convertRow(rowNumber)
colNumber = convertCol(colNumber)
NUMBER_RECORD\opcode = 3
NUMBER_RECORD\length = 15
NUMBER_RECORD\rowNumber = rowNumber
NUMBER_RECORD\colNumber = colNumber
NUMBER_RECORD\rgbAttr1 = hiddenLocked
NUMBER_RECORD\rgbAttr2 = cellFont + cellFormat
NUMBER_RECORD\rgbAttr3 = cellAlignment
NUMBER_RECORD\numberValue = value
CopyMemory(@NUMBER_RECORD, *memArea, SizeOf(NUMBER_RECORD))
memLength = SizeOf(NUMBER_RECORD)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out a text value
; **********************************************************************************
Procedure.i xlsWriteText(*memArea, *value, lenVal.i, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Protected TEXT_RECORD.TYPE_TEXT
Protected memLength.i
; convert the row, col from LONG to INTEGER.
rowNumber = convertRow(rowNumber)
colNumber = convertCol(colNumber)
TEXT_RECORD\opcode = 4
TEXT_RECORD\length = 10
TEXT_RECORD\textLength = lenVal
TEXT_RECORD\length = 8 + lenVal
TEXT_RECORD\rowNumber = rowNumber
TEXT_RECORD\colNumber = colNumber
TEXT_RECORD\rgbAttr1 = hiddenLocked
TEXT_RECORD\rgbAttr2 = cellFont + cellFormat
TEXT_RECORD\rgbAttr3 = cellAlignment
CopyMemory(@TEXT_RECORD, *memArea, SizeOf(TEXT_RECORD))
memLength = SizeOf(TEXT_RECORD)
; then the actual string data
CopyMemory(*value, *memArea + memLength, lenVal)
memLength = memLength + lenVal
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out a date value
; **********************************************************************************
Procedure.i xlsWriteDate(*memArea, *dateString, rowNumber.i, colNumber.i, cellFont.i, cellAlignment.i, hiddenLocked.i, cellFormat.i)
Protected NUMBER_RECORD.TYPE_NUMBER
Protected memLength.i
Protected value.d
; convert the row, col from LONG to INTEGER.
rowNumber = convertRow(rowNumber)
colNumber = convertCol(colNumber)
; convert the dateString$ to a Julian date number, dateString$ must be in YYYYMMDDHHMMSS format
value = convertDate(*dateString)
NUMBER_RECORD\opcode = 3
NUMBER_RECORD\length = 15
NUMBER_RECORD\rowNumber = rowNumber
NUMBER_RECORD\colNumber = colNumber
NUMBER_RECORD\rgbAttr1 = hiddenLocked
NUMBER_RECORD\rgbAttr2 = cellFont + cellFormat
NUMBER_RECORD\rgbAttr3 = cellAlignment
NUMBER_RECORD\numberValue = value
CopyMemory(@NUMBER_RECORD, *memArea, SizeOf(NUMBER_RECORD))
memLength = SizeOf(NUMBER_RECORD)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write the spreadsheet's margin layout information (in inches)
; **********************************************************************************
Procedure.i xlsSetMargin(*memArea, margin.i, marginValue.i)
Protected MARGINRECORD.MARGIN_RECORD_LAYOUT
Protected memLength.i
; Margin should be one of the following....
Select margin
Case #xlsLeftMargin; 38
Case #xlsRightMargin; 39
Case #xlsTopMargin; 40
Case #xlsBottomMargin; 41
Default
margin = 38
EndSelect
MARGINRECORD\opcode = margin
MARGINRECORD\length = 8
MARGINRECORD\marginValue = marginValue ; in inches
CopyMemory(@MARGINRECORD, *memArea, SizeOf(MARGINRECORD))
memLength = SizeOf(MARGINRECORD)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write the spreadsheet's column width, values are specified as 1/256 of a character
; **********************************************************************************
Procedure.i xlsSetColumnWidth(*memArea, firstColumn.i, lastColumn.i, widthValue.i)
Protected COLWIDTH.COLWIDTH_RECORD
Protected memLength.i
COLWIDTH\opcode = 36
COLWIDTH\length = 4
COLWIDTH\colOne = firstColumn - 1
COLWIDTH\colTwo = lastColumn - 1
COLWIDTH\columnWidth = widthValue * 256
CopyMemory(@COLWIDTH, *memArea, SizeOf(COLWIDTH))
memLength = SizeOf(COLWIDTH)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write the spreadsheet's fonts, you can set up to 4 fonts in the spreadsheet file
; **********************************************************************************
Procedure.i xlsSetFont(*memArea, *fontName, lenVal.i, fontHeight.i, fontFormat.i)
; when writing a value such as a Text or Number you can specify one of the 4 fonts (numbered 0 to 3)
Protected FONTNAME_RECORD.FONT_RECORD
Protected memLength.i
FONTNAME_RECORD\opcode = 49
FONTNAME_RECORD\length = 5 + lenVal
FONTNAME_RECORD\fontHeight = fontHeight * 20
FONTNAME_RECORD\fontAttributes1 = fontFormat ; bold/underline etc...
FONTNAME_RECORD\fontAttributes2 = 0 ; reserved-always zero!!
FONTNAME_RECORD\fontNameLength = lenVal
CopyMemory(@FONTNAME_RECORD, *memArea, SizeOf(FONTNAME_RECORD))
memLength = SizeOf(FONTNAME_RECORD)
; then the actual font name data
CopyMemory(*fontName, *memArea + memLength, lenVal)
memLength = memLength + lenVal
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write the spreadsheet's header
; **********************************************************************************
Procedure.i xlsSetHeader(*memArea, *headerText, lenVal.i)
Protected HEADER_RECORD.HEADER_FOOTER_RECORD
Protected memLength.i
HEADER_RECORD\opcode = 20
HEADER_RECORD\length = 1 + lenVal
HEADER_RECORD\textLength = lenVal
CopyMemory(@HEADER_RECORD, *memArea, SizeOf(HEADER_RECORD))
memLength = SizeOf(HEADER_RECORD)
; then the actual Header text
CopyMemory(*headerText, *memArea + memLength, lenVal)
memLength = memLength + lenVal
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write the spreadsheet's footer
; **********************************************************************************
Procedure.i xlsSetFooter(*memArea, *footerText, lenVal.i)
Protected FOOTER_RECORD.HEADER_FOOTER_RECORD
Protected memLength.i
FOOTER_RECORD\opcode = 21
FOOTER_RECORD\length = 1 + lenVal
FOOTER_RECORD\textLength = lenVal
CopyMemory(@FOOTER_RECORD, *memArea, SizeOf(FOOTER_RECORD))
memLength = SizeOf(FOOTER_RECORD)
; then the actual Header text
CopyMemory(*footerText, *memArea + memLength, lenVal)
memLength = memLength + lenVal
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write the spreadsheet's password
; **********************************************************************************
Procedure.i xlsSetFilePassword(*memArea, *passwordText, lenVal.i)
Protected FILE_PASSWORD_RECORD.PASSWORD_RECORD
Protected memLength.i
FILE_PASSWORD_RECORD\opcode = 47
FILE_PASSWORD_RECORD\length = lenVal
CopyMemory(@FILE_PASSWORD_RECORD, *memArea, SizeOf(FILE_PASSWORD_RECORD))
memLength = SizeOf(FILE_PASSWORD_RECORD)
; then the actual Password text
CopyMemory(*passwordText, *memArea + memLength, lenVal)
memLength = memLength + lenVal
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out the spreadsheet's grid lines if needed
; **********************************************************************************
Procedure.i xlsPrintGridLines(*memArea, trueFalse.i)
Protected GRIDLINES_RECORD.PRINT_GRIDLINES_RECORD
Protected memLength.i
GRIDLINES_RECORD\opcode = 43
GRIDLINES_RECORD\length = 2
If trueFalse = 0
GRIDLINES_RECORD\printFlag = 0
Else
GRIDLINES_RECORD\printFlag = 1
EndIf
CopyMemory(@GRIDLINES_RECORD, *memArea, SizeOf(GRIDLINES_RECORD))
memLength = SizeOf(GRIDLINES_RECORD)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out the spreadsheet's protection cell, if needed
; **********************************************************************************
Procedure.i xlsProtectSpreadsheet(*memArea, trueFalse.i)
Protected PROTECT_RECORD.PROTECT_SPREADSHEET_RECORD
Protected memLength.i
PROTECT_RECORD\opcode = 18
PROTECT_RECORD\length = 2
If trueFalse = 0
PROTECT_RECORD\protect = 0
Else
PROTECT_RECORD\protect = 1
EndIf
CopyMemory(@PROTECT_RECORD, *memArea, SizeOf(PROTECT_RECORD))
memLength = SizeOf(PROTECT_RECORD)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out the spreadsheet's default format
; **********************************************************************************
Procedure.i xlsWriteDefaultFormats(*memArea)
Protected FORMAT_DEFAULT.FORMAT_COUNT_RECORD
Protected FORMAT_CELLS.FORMAT_RECORD
Protected numIndex.i
Protected Dim formatType.s(23)
Protected formatCount.i = 23
Protected lenFormat.i
Protected memLength.i
formatType(0) = "General"
formatType(1) = "0"
formatType(2) = "0.00"
formatType(3) = "#,##0"
formatType(4) = "#,##0.00"
formatType(5) = "#,##0\ " + #dblQuote + "$" + #dblQuote + ";\-#,##0\ " + #dblQuote + "$" + #dblQuote
formatType(6) = "#,##0\ " + #dblQuote + "$" + #dblQuote + ";[Red]\-#,##0\ " + #dblQuote + "$" + #dblQuote
formatType(7) = "#,##0.00\ " + #dblQuote + "$" + #dblQuote + ";\-#,##0.00\ " + #dblQuote + "$" + #dblQuote
formatType(8) = "#,##0.00\ " + #dblQuote + "$" + #dblQuote + ";[Red]\-#,##0.00\ " + #dblQuote + "$" + #dblQuote
formatType(9) = "0%"
formatType(10) = "0.00%"
formatType(11) = "0.00E+00"
formatType(12) = "yyyy-mm-dd"
formatType(13) = "dd/\ mmm\ yy"
formatType(14) = "dd/\ mmm"
formatType(15) = "mmm\ yy"
formatType(16) = "h:mm\ AM/PM"
formatType(17) = "h:mm:ss\ AM/PM"
formatType(18) = "hh:mm"
formatType(19) = "hh:mm:ss"
formatType(20) = "dd/mm/yy\ hh:mm"
formatType(21) = "##0.0E+0"
formatType(22) = "mm:ss"
formatType(23) = "@"
FORMAT_DEFAULT\opcode = $1F
FORMAT_DEFAULT\length = $2
FORMAT_DEFAULT\countNum = formatCount
CopyMemory(@FORMAT_DEFAULT, *memArea, SizeOf(FORMAT_DEFAULT))
memLength = SizeOf(FORMAT_DEFAULT)
; write out each of the formats here
For numIndex=0 To formatCount
lenFormat = Len(formatType(numIndex))
FORMAT_CELLS\opcode = $1E
FORMAT_CELLS\length = lenFormat + 1
FORMAT_CELLS\formatLength = lenFormat
CopyMemory(@FORMAT_CELLS, *memArea + memLength, SizeOf(FORMAT_CELLS))
memLength = memLength + SizeOf(FORMAT_CELLS)
; then the actual format
CopyMemory(@formatType(numIndex), *memArea + memLength, lenFormat)
memLength = memLength + lenFormat
Next
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out the spreadsheet's default row height
; **********************************************************************************
Procedure.i xlsSetDefaultRowHeight(*memArea, heightValue.i)
Protected DEFHEIGHT.DEF_ROWHEIGHT_RECORD
Protected memLength.i
; Height is defined in units of 1/20th of a point. Therefore, a 10-point font
; would be 200 (i.e. 200/20 = 10). This Procedure takes a heightValue such as
; 14 point and converts it the correct size before writing it to the file.
DEFHEIGHT\opcode = 37
DEFHEIGHT\length = 2
DEFHEIGHT\rowHeight = heightValue * 20 ; convert points to 1/20ths of point
CopyMemory(@DEFHEIGHT, *memArea, SizeOf(DEFHEIGHT))
memLength = SizeOf(DEFHEIGHT)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; write out the spreadsheet's row height
; **********************************************************************************
Procedure.i xlsSetRowHeight(*memArea, rowNumber.i, heightValue.i)
Protected ROWHEIGHTREC.ROW_HEIGHT_RECORD
Protected memLength.i
; convert the row, col from LONG to INTEGER.
rowNumber = convertRow(rowNumber)
; Height is defined in units of 1/20th of a point. Therefore, a 10-point font
; would be 200 (i.e. 200/20 = 10). This Procedure takes a heightValue such as
; 14 point and converts it the correct size before writing it to the file.
ROWHEIGHTREC\opcode = 8
ROWHEIGHTREC\length = 16
ROWHEIGHTREC\rowNumber = rowNumber
ROWHEIGHTREC\firstColumn = 0
ROWHEIGHTREC\lastColumn = 256
ROWHEIGHTREC\rowHeight = heightValue * 20 ; convert points to 1/20ths of point
ROWHEIGHTREC\internal = 0
ROWHEIGHTREC\defaultAttributes = 0
ROWHEIGHTREC\fileOffset = 0
ROWHEIGHTREC\rgbAttr1 = 0
ROWHEIGHTREC\rgbAttr2 = 0
ROWHEIGHTREC\rgbAttr3 = 0
CopyMemory(@ROWHEIGHTREC, *memArea, SizeOf(ROWHEIGHTREC))
memLength = SizeOf(ROWHEIGHTREC)
ProcedureReturn memLength
EndProcedure
; **********************************************************************************
; converrt the date to internal excel format
; **********************************************************************************
Procedure.d convertDate(*dateString)
Protected year.f
Protected month.i
Protected day.i
Protected hour.i
Protected minute.i
Protected second.i
Protected doy.i
Protected inTime.i
Protected leapYear.i
Protected elapsed.d
; dateString$ must be in YYYYMMDDHHMMSS
year = ValF(PeekS(*dateString + 0, 4))
month = Val(PeekS(*dateString + 4, 2))
day = Val(PeekS(*dateString + 6, 2))
hour = Val(PeekS(*dateString + 8, 2))
minute = Val(PeekS(*dateString + 10, 2))
second = Val(PeekS(*dateString + 12, 2))
If year < 1900 Or year > 2100 Or month < 1 Or month > 12 Or day < 1 Or day > 31
ProcedureReturn 0
EndIf
; if the year is not a leap year, add 1
If year / 4 = Int(year / 4)
If year / 100 = Int(year / 100)
If year / 400 = Int(year / 400)
leapYear = 1
Else
leapYear = 0
EndIf
Else
leapYear = 1
EndIf
Else
leapYear = 0
EndIf
; determine the day number of the year
doy = DayOfYear(Date(year, month, day, 0, 0, 0))
year = year - 1900
elapsed = Int(year * 365.25 + doy)
If Not leapYear
elapsed = elapsed + 1
EndIf
; now find the factional time of day
inTime = (hour * 60 * 60) + (minute * 60) + second
; add them together to get the excel date and time format
elapsed = elapsed + (inTime / 86400)
ProcedureReturn elapsed
EndProcedureCode: Select all
XIncludeFile "excel.pbi"
#XLSFALSE = 0
#XLSTRUE = 1; Not #XLSFALSE
;Create the new spreadsheet
Define mFileName.s = "test02.xls" ;create spreadsheet in the current directory
Define xlsFileNumber.i
Define stat.i
Define *memLocation = AllocateMemory(1000000)
Define memoryLoc.i = *memLocation
Define memLength.i
Define totalMem.i
memLength = xlsBeginFile(memoryLoc)
memoryLoc = memoryLoc + memLength
;specify whether to print the gridlines or not
;this should come before the setting of fonts and margins
memLength = xlsPrintGridLines(memoryLoc, #XLSTRUE)
memoryLoc = memoryLoc + memLength
;it is a good idea to set margins, fonts and column widths
;prior to writing any text/numerics to the spreadsheet. These
;should come before setting the fonts.
memLength = xlsSetMargin(memoryLoc, #xlsTopMargin, 1.5) ;set to 1.5 inches
memoryLoc = memoryLoc + memLength
memLength = xlsSetMargin(memoryLoc, #xlsLeftMargin, 1.5)
memoryLoc = memoryLoc + memLength
memLength = xlsSetMargin(memoryLoc, #xlsRightMargin, 1.5)
memoryLoc = memoryLoc + memLength
memLength = xlsSetMargin(memoryLoc, #xlsBottomMargin, 1.5)
memoryLoc = memoryLoc + memLength
;Up to 4 fonts can be specified for the spreadsheet. This is a
;limitation of the Excel 2.1 format. For each value written to the
;spreadsheet you can specify which font to use.
Define font.s
Define lenFont.i
font = "Arial"
lenFont = Len(font)
memLength = xlsSetFont(memoryLoc, @font, lenFont, 10, #xlsNoFormat) ;font0
memoryLoc = memoryLoc + memLength
memLength = xlsSetFont(memoryLoc, @font, lenFont, 10, #xlsBold) ;font1
memoryLoc = memoryLoc + memLength
memLength = xlsSetFont(memoryLoc, @font, lenFont, 24, #xlsBold + #xlsUnderline) ;font2
memoryLoc = memoryLoc + memLength
font = "Courier"
lenFont = Len(font)
memLength = xlsSetFont(memoryLoc, @font, lenFont, 18, #xlsItalic) ;font3
memoryLoc = memoryLoc + memLength
;Column widths are specified in Excel as 1/256th of a character.
memLength = xlsSetColumnWidth(memoryLoc, 1, 1, 50)
memoryLoc = memoryLoc + memLength
memLength = xlsSetColumnWidth(memoryLoc, 2, 2, 20)
memoryLoc = memoryLoc + memLength
;set the global row height for the entire spreadsheet
memLength = xlsSetDefaultRowHeight(memoryLoc, 24)
memoryLoc = memoryLoc + memLength
;set the height of the first two rows a little bigger to allow for the
;title of the spreadsheet.
memLength = xlsSetRowHeight(memoryLoc, 1, 24)
memoryLoc = memoryLoc + memLength
memLength = xlsSetRowHeight(memoryLoc, 2, 24)
memoryLoc = memoryLoc + memLength
;set any header or footer that you want to print on
;every page. This text will be centered at the top and/or
;bottom of each page. The font will always be the font that
;is specified as font0, therefore you should only set the
;header/footer after specifying the fonts through SetFont.
Define header.s = "This is the header"
Define footer.s = "This is the footer"
Define lenHeader.i = Len(header)
Define lenFooter.i = Len(footer)
memLength = xlsSetHeader(memoryLoc, @header, lenHeader)
memoryLoc = memoryLoc + memLength
memLength = xlsSetFooter(memoryLoc, @footer, lenFooter)
memoryLoc = memoryLoc + memLength
;write some data to the spreadsheet
memLength = xlsWriteInteger(memoryLoc, 20, 6, 1, #xlsFont0, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
;write a cell with a shaded number with a bottom border
memLength = xlsWriteNumber(memoryLoc, 12123456, 7, 1, #xlsFont1, #xlsrightAlign + #xlsBottomBorder + #xlsShaded, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
;write a normal left aligned string using font2 (bold & underline)
Define text.s
Define lenText.i
text = "This is a long test string"
lenText = Len(text)
memLength = xlsWriteText(memoryLoc, @text, lenText, 8, 1, #xlsFont2, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
;write a locked cell. The cell will not be able to be overwritten, BUT you
;must set the sheet PROTECTION to on before it will take effect!!!
text = "This cell is locked."
lenText = Len(text)
memLength = xlsWriteText(memoryLoc, @text, lenText, 9, 1, #xlsFont3, #xlsLeftAlign, #xlsCellLocked, 0)
memoryLoc = memoryLoc + memLength
;fill the cell with F's
text = "F"
lenText = Len(text)
memLength = xlsWriteText(memoryLoc, @text, lenText, 10, 1, #xlsFont3, #xlsFillCell, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
;write a hidden cell to the spreadsheet. This only works for cells
;that contain formula. Text, Number, Integer value text can not be hidden
;using this feature. It is included here for the sake of completeness.
text = "If this were a formula it would be hidden!"
lenText = Len(text)
memLength = xlsWriteText(memoryLoc, @text, lenText, 11, 1, #xlsFont0, #xlsCenterAlign, #xlsCellHidden, 0)
memoryLoc = memoryLoc + memLength
;========================================================================
text = "=14 * 134"
lenText = Len(text)
memLength = xlsWriteText(memoryLoc, @text, lenText, 11, 2, #xlsFont0, #xlsCenterAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
;========================================================================
text = "14 * 134"
lenText = Len(text)
memLength = xlsWriteText(memoryLoc, @text, lenText, 11, 3, #xlsFont0, #xlsCenterAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
;========================================================================
;write a date to the file. Dates can be written as literal text strings but doing so will not allow
;the date to be formatted.
Define mDate.s
; date is the number of days since 1900, format comes from xlsWriteDefaultFormats(), and is last passed variable
mDate = FormatDate("%yyyy%mm%dd%hh%ii%ss", Date())
lenText = Len(mDate)
memLength = xlsWriteText(memoryLoc, @mDate, lenText, 14, 1, #xlsFont0, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
memLength = xlsWriteDate(memoryLoc, @mDate, 14, 2, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 12)
memoryLoc = memoryLoc + memLength
;========================================================================
mDate = "20000101121314"; literal date 2000/01/01
lenText = Len(mDate)
memLength = xlsWriteText(memoryLoc, @mDate, lenText, 15, 1, #xlsFont0, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
memLength = xlsWriteDate(memoryLoc, @mDate, 15, 2, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 13)
memoryLoc = memoryLoc + memLength
;========================================================================
mDate = "19700101121314"; literal date 1970/01/01
lenText = Len(mDate)
memLength = xlsWriteText(memoryLoc, @mDate, lenText, 16, 1, #xlsFont0, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
memLength = xlsWriteDate(memoryLoc, @mDate, 16, 2, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 14)
memoryLoc = memoryLoc + memLength
;========================================================================
mDate = "19650101121314"; literal date 1965/01/01
lenText = Len(mDate)
memLength = xlsWriteText(memoryLoc, @mDate, lenText, 17, 1, #xlsFont0, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
memLength = xlsWriteDate(memoryLoc, @mDate, 17, 2, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 15)
memoryLoc = memoryLoc + memLength
;========================================================================
mDate = "19571127121314"; literal date 1957/11/27
lenText = Len(mDate)
memLength = xlsWriteText(memoryLoc, @mDate, lenText, 18, 1, #xlsFont0, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
memLength = xlsWriteDate(memoryLoc, @mDate, 18, 2, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 20)
memoryLoc = memoryLoc + memLength
;insert page breaks
xlsInsertHorizPageBreak(20)
xlsInsertHorizPageBreak(40)
;write consecutive numbers in the column
Define NumRows.i = 500
Define x.i
For x=1 To NumRows
memLength = xlsWriteNumber(memoryLoc, x, 20 + x, 1, #xlsFont1, #xlsLeftAlign, #xlsCellNormal, 0)
memoryLoc = memoryLoc + memLength
Next
;PROTECT the spreadsheet so any cells specified as LOCKED will not be
;overwritten. Also, all cells with HIDDEN set will hide their formula.
;PROTECT does not use a password.
; stat = xlsProtectSpreadsheet(#XLSTRUE)
; then when done, close the spreadsheet, write the data, then end
memLength = xlsCloseFile(memoryLoc)
memoryLoc = memoryLoc + memLength
totalMem = memoryLoc - *memLocation
xlsFileNumber = CreateFile(#PB_Any, mFileName)
WriteData(xlsFileNumber, *memLocation, totalMem)
CloseFile(xlsFileNumber)
FreeMemory(*memLocation)
End