More Excel

RichAlgeni · Post by **RichAlgeni** » 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

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

EndProcedure

excel_test.pb

Code: 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

Puffolino · Post by **Puffolino** » Wed Dec 19, 2012 7:02 am

I'm using my phone now, so giving you the link is impossible (for me), but have a look into a thread "excel cell limitations" or so, Michael V. has added a working code for using text colors (hope that's what you are searching for)...

RichAlgeni · Post by **RichAlgeni** » Wed Dec 19, 2012 9:56 pm

Thanks Puff!

Kwai chang caine · Post by **Kwai chang caine** » Thu Dec 20, 2012 2:54 pm

Works great here
Thanks for sharing

RichAlgeni · Post by **RichAlgeni** » Thu Dec 20, 2012 5:10 pm

You're welcome KCC!

decypher · Post by **decypher** » Tue Feb 05, 2013 8:59 am

Can please someone give an example on how to search for some value in excel and return row number?

I have working pice of code here:

excelFileRow = ExcelObject\GetIntegerProperty("ActiveSheet\Columns(4)\Find('value')\Row")

that is looking for "value" in column 4 but it can return rows that contain: value, valu and val. etc.
I need to find whole word. So the problem is to set additional parameters to Find statement to look only whole words.

I tried doing such thing:

excelFileRow = ExcelObject\GetIntegerProperty("ActiveSheet\Columns(4)\Find('value', '$D$4', -4123, 1, 1, 1, 1, 0, 0)\Row")

But no luck...

Thank you!

RichAlgeni · Post by **RichAlgeni** » Tue Feb 05, 2013 7:14 pm

I don't know the answer to that, sorry! But I do know who might. Send a message to 'SRod', Stephen wrote comate, and should be able to help.

Rich

decypher · Post by **decypher** » Fri Feb 08, 2013 9:25 pm

decypher wrote:I need to find whole word. So the problem is to set additional parameters to Find statement to look only whole words.

I tried doing such thing:

excelFileRow = ExcelObject\GetIntegerProperty("ActiveSheet\Columns(4)\Find('value', '$D$4', -4123, 1, 1, 1, 1, 0, 0)\Row")

But no luck...

found solution for my very personal case... just replaced the optional parameters with #optional statement. like this:

excelFileRow = ExcelObject\GetIntegerProperty("ActiveSheet\Columns(4)\Find('value', #optional, #optional, 1)\Row")

1 stands here for xlWhole to find whole words in column.

LiK137 · Post by **LiK137** » Mon May 20, 2019 10:44 pm

Many thanx for Excel functions.
Is there any way to with Unicode support?
I've been trying with poke, #PB_Unicode, #PB_UTF8 but no way.

Thanx in advance for any help

RichAlgeni · Post by **RichAlgeni** » Mon May 20, 2019 10:58 pm

I had the same issue, but the solution I came up with did not use this code. What I ended up doing was to create a spreadsheet exactly the way I wanted to see it, manually using Excel. Then, I saved it as an xml 2003 file, then just reverse engineered it. It was a pain, but it worked.

LiK137 · Post by **LiK137** » Tue May 21, 2019 5:51 am

Thanks RichAlgeni I'm sure You are right about there is a solution using reverse engineering but what about this PBInclude?

PureBasic Forums - English

More Excel

More Excel

Re: More Excel

Re: More Excel

Re: More Excel

Re: More Excel

Re: More Excel

Re: More Excel

Re: More Excel

Re: More Excel

Re: More Excel

Re: More Excel