Hi, I have a backup.txt with this information...
----------------------------------------------------------------
| Start Backup | End Backup | %Bckup |
---------------------------------------------------------------
| 23/06/2004 22:00:2 | 23/06/2004 22:05:5 | 100% |
| 24/06/2004 2:00:28 | 24/06/2004 2:06:53 | 100% |
| 24/06/2004 2:15:10 | 24/06/2004 2:22:51 | 100% |
| 24/06/2004 4:00:13 | 24/06/2004 4:05:39 | 100% |
how can I export it in a EXCEL sheet?
Thank you
export table in .TXT file to EXCEL, how can I do it?
you mean import in excel?
if so you just go to the menu: file -> open.. choose textfile.. then do the "import wizard" and choose the pipe "|" as the separator or something.. you might want to play with it abit..
If I'm totally off, then just ignore my post!! :p
if so you just go to the menu: file -> open.. choose textfile.. then do the "import wizard" and choose the pipe "|" as the separator or something.. you might want to play with it abit..
If I'm totally off, then just ignore my post!! :p
AMD Athlon XP2400, 512 MB RAM, Hercules 3D Prophet 9600 256MB RAM, WinXP
PIII 800MHz, 320 MB RAM, Nvidia Riva Tnt 2 Mach 64 (32MB), WinXP + Linux
17" iMac, 1.8 GHz G5, 512 MB DDR-RAM, 80 GB HD, 64 MB Geforce FX 5200, SuperDrive, OSX
You might be able to accomplish this convertion using the ActiveX2Dll tool from Ricardo. Here is a thread on the subject: viewtopic.php?t=6649&highlight=com+excel
Personally, I would save the status output as a nicely formatted html file that contains all your data in a table. Then your status output would be instantly cross-platform capable!
-Beach
Personally, I would save the status output as a nicely formatted html file that contains all your data in a table. Then your status output would be instantly cross-platform capable!
-Beach
Do you definately need to use XLS format.
Excel associates itself with CSV files on installation, so if you use a CSV format it will open automatically in Excel.
Other options for controlling Excel are:
COM
viewtopic.php?t=10836
DDE
http://www.techsoft.de/htbasic/support/ddeexam1.htm
ODBC
http://support.microsoft.com/default.as ... bContent=1
Excel associates itself with CSV files on installation, so if you use a CSV format it will open automatically in Excel.
Other options for controlling Excel are:
COM
viewtopic.php?t=10836
DDE
http://www.techsoft.de/htbasic/support/ddeexam1.htm
ODBC
http://support.microsoft.com/default.as ... bContent=1
I've used the trick of making it a CSV/TSV file (comma separated or tab separated) and change the file extension to .xls - Excel reads those formats native.
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Thank to all 
, I like all answers.
I will use http://www.techsoft.de/htbasic/support/ddeexam1.htm (thank you GedB)
This is a great comunity
, I like all answers.I will use http://www.techsoft.de/htbasic/support/ddeexam1.htm (thank you GedB)
This is a great comunity
-
NoahPhense
- Addict
- Posts: 1999
- Joined: Thu Oct 16, 2003 8:30 pm
- Location: North Florida
..
Would like to see your dde code when your done. If you are into sharingzikitrake wrote:Thank to all
I will use http://www.techsoft.de/htbasic/support/ddeexam1.htm (thank you GedB)
This is a great comunity
it.
- np
Just remembered the Chicago project:
http://chicago.sourceforge.net/
*edit*
That project doesn't seem to have gone very far. However it does link to some other projects, on this page:
http://chicago.sourceforge.net/devel/docs/excel/
*edit*
This project is a small PHP for creating simple excel files. Just 196 lines of code. Should be easy to convert, especially considering PB is better than PHP at handling binary formats.
http://sf.net/projects/psxlsgen
http://chicago.sourceforge.net/
*edit*
That project doesn't seem to have gone very far. However it does link to some other projects, on this page:
http://chicago.sourceforge.net/devel/docs/excel/
*edit*
This project is a small PHP for creating simple excel files. Just 196 lines of code. Should be easy to convert, especially considering PB is better than PHP at handling binary formats.
http://sf.net/projects/psxlsgen
-
NoahPhense
- Addict
- Posts: 1999
- Joined: Thu Oct 16, 2003 8:30 pm
- Location: North Florida
..
(created in another basic)
There are two files here, excel.inc and test.bas .. They need converting
to PB, I don't have the time. But if someone did, they would be known
for bringing excel to PB..
EXCEL.INC
TEST.BAS
...and if you get bored.. lol
http://sc.openoffice.org/excelfileformat.pdf
- np
There are two files here, excel.inc and test.bas .. They need converting
to PB, I don't have the time. But if someone did, they would be known
for bringing excel to PB..
EXCEL.INC
Code: Select all
'Excel.inc - Include file for BIFF 2.1 specifications to write Excel files.
'
'Class file for writing Microsoft Excel BIFF 2.1 files.
'
'This class is intended for users who do not want to use the huge
'Jet or ADO providers if they only want to export their data to
'an Excel compatible file.
'Newer versions of Excel use the OLE Structure Storage methods
'which are quite complicated.
'constants to hold cell alignment
%xlsGeneralAlign = 0
%xlsLeftAlign = 1
%xlsCentreAlign = 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
'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
Type FONT_RECORD
opcode As Integer '49
length As Integer '5+len(fontname)
FontHeight As Integer
'bit0 bold, bit1 italic, bit2 underline, bit3 strikeout, bit4-7 reserved
FontAttributes1 As Byte
FontAttributes2 As Byte 'reserved - always 0
FontNameLength As Byte
End Type
Type PASSWORD_RECORD
opcode As Integer '47
length As Integer 'len(password)
End Type
Type HEADER_FOOTER_RECORD
opcode As Integer '20 Header, 21 Footer
length As Integer '1+len(text)
TextLength As Byte
End Type
Type PROTECT_SPREADSHEET_RECORD
opcode As Integer '18
length As Integer '2
Protect As Integer
End Type
Type FORMAT_COUNT_RECORD
opcode As Integer '1f
length As Integer '2
Count As Integer
End Type
Type FORMAT_RECORD
opcode As Integer '1e
length As Integer '1+len(format)
FormatLength As Byte 'len(format)
End Type '+ followed by the Format-Picture
Type COLWIDTH_RECORD
opcode As Integer '36
length As Integer '4
col1 As Byte 'first column
col2 As Byte 'last column
ColumnWidth As Integer 'at 1/256th of a character
End Type
'Beginning Of File record
Type BEG_FILE_RECORD
opcode As Integer
length As Integer
version As Integer
ftype As Integer
End Type
'End Of File record
Type END_FILE_RECORD
opcode As Integer
length As Integer
End Type
'true/false to print gridlines
Type PRINT_GRIDLINES_RECORD
opcode As Integer
length As Integer
PrintFlag As Integer
End Type
'Integer record
Type tInteger
opcode As Integer
length As Integer
Row As Integer 'unsigned integer
col As Integer
'rgbAttr1 handles whether cell is hidden and/or locked
rgbAttr1 As Byte
'rgbAttr2 handles the Font# and Formatting assigned to this cell
rgbAttr2 As Byte
'rgbAttr3 handles the Cell Alignment/borders/shading
rgbAttr3 As Byte
intValue As Integer 'the actual integer value
End Type
'Number record
Type tNumber
opcode As Integer
length As Integer
Row As Integer
col As Integer
rgbAttr1 As Byte
rgbAttr2 As Byte
rgbAttr3 As Byte
NumberValue As Double '8 Bytes
End Type
'Label (Text) record
Type tText
opcode As Integer
length As Integer
Row As Integer
col As Integer
rgbAttr1 As Byte
rgbAttr2 As Byte
rgbAttr3 As Byte
TextLength As Byte
End Type
Type MARGIN_RECORD_LAYOUT
opcode As Integer
length As Integer
MarginValue As Double '8 bytes
End Type
Type HPAGE_BREAK_RECORD
opcode As Integer
length As Integer
NumPageBreaks As Integer
End Type
Type DEF_ROWHEIGHT_RECORD
opcode As Integer
length As Integer
RowHeight As Integer
End Type
Type ROW_HEIGHT_RECORD
opcode As Integer '08
length As Integer 'should always be 16 bytes
RowNumber As Integer
FirstColumn As Integer
LastColumn As Integer
RowHeight As Integer 'written to file as 1/20ths of a point
internal As Integer
DefaultAttributes As Byte 'set to zero for no default attributes
FileOffset As Integer
rgbAttr1 As Byte
rgbAttr2 As Byte
rgbAttr3 As Byte
End Type
Global xlsFileNumber As Long
Global xlsBufferSize As Long 'if > 0 then buffer is active, also holds size of buffer.
Global xlsBufferString As String
'create an array that will hold the rows where a horizontal page
'break will be inserted just before.
Global xlsHorizPageBreakRows() As Long
Global xlsNumHorizPageBreaks As Long
Declare Function xlsCreateFile(mFileName$) As Long
Declare Function xlsCloseFile() As Long
Declare Function xlsInsertHorizPageBreak(ByVal lrow As Long) As Long
Declare Function xlsWriteInteger(ByVal value%, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
Declare Function xlsWriteNumber(ByVal value#, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
Declare Function xlsWriteText(value$, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
Declare Function xlsWriteDate(DateString$, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
Declare Function xlsSetMargin(ByVal Margin&, ByVal MarginValue#) As Long
Declare Function xlsSetColumnWidth(ByVal FirstColumn&, ByVal LastColumn&, ByVal WidthValue&) As Long
Declare Function xlsSetFont(FontName$, ByVal FontHeight&, ByVal FontFormat&) As Long
Declare Function xlsSetHeader(HeaderText$) As Long
Declare Function xlsSetFooter(FooterText$) As Long
Declare Function xlsSetFilePassword(PasswordText$) As Long
Declare Function xlsPrintGridLines(ByVal TrueFalse&) As Long
Declare Function xlsProtectSpreadsheet(ByVal TrueFalse&) As Long
Declare Function xlsWriteDefaultFormats() As Long
Declare Function xlsSetDefaultRowHeight(ByVal HeightValue&) As Long
Declare Function xlsSetRowHeight(ByVal lrow&, ByVal HeightValue&) As Long
Declare Function ConvertRow(ByVal lrow As Long) As Integer
Declare Function ConvertCol(ByVal lcol As Long) As Integer
Declare Function DateToJulian&(DateString$) As Long
Declare Function CTOD(PBDate As String) As String
Declare Function xlsBuffer(ByVal TrueFalse&, ByVal BufferSize&) As Long
Declare Function UpdateBuffer(BufferString$) As Long
Function xlsCreateFile(mFileName$) As Long
If Dir$(mFileName$) > "" Then
Kill mFileName$
If ErrClear Then
Function = -1
Exit Function
End If
End If
Dim BEG_FILE_MARKER As BEG_FILE_RECORD
'beginning of file
BEG_FILE_MARKER.opcode = 9
BEG_FILE_MARKER.length = 4
BEG_FILE_MARKER.version = 2
BEG_FILE_MARKER.ftype = 10
xlsFileNumber = FreeFile
Open mFileName$ For Binary As #xlsFileNumber
'if the buffer us active then save the data to the buffer
'otherwise then simply write to the file.
If xlsBufferSize Then
stat& = UpdateBuffer((BEG_FILE_MARKER))
Else
Put #xlsFileNumber, , BEG_FILE_MARKER 'must always be written first
If ErrClear Then
Function = -1
Exit Function
End If
End If
'write the default formats to the file
'and return if error occured.
If xlsWriteDefaultFormats Then Exit Function
'create the Horizontal Page Break array
ReDim xlsHorizPageBreakRows(0)
xlsNumHorizPageBreaks = 0
Function = 0 'return with no error
End Function
Function xlsCloseFile() As Long
If xlsFileNumber = 0 Then
Function = -1
Exit Function
End If
'write the horizontal page breaks if necessary
If xlsNumHorizPageBreaks > 0 Then
'the Horizontal Page Break array must be in sorted order.
'Use a simple Bubble sort because the size of this array would
'be pretty small most of the time. A QuickSort would probably
'be overkill.
Dim lLoop1 As Long
Dim lLoop2 As Long
Dim lTemp As Long
For lLoop1 = UBound(xlsHorizPageBreakRows) To LBound(xlsHorizPageBreakRows) Step -1
For lLoop2 = LBound(xlsHorizPageBreakRows) + 1 To lLoop1
If xlsHorizPageBreakRows(lLoop2 - 1) > xlsHorizPageBreakRows(lLoop2) Then
lTemp = xlsHorizPageBreakRows(lLoop2 - 1)
xlsHorizPageBreakRows(lLoop2 - 1) = xlsHorizPageBreakRows(lLoop2)
xlsHorizPageBreakRows(lLoop2) = lTemp
End If
Next lLoop2
Next lLoop1
'write the Horizontal Page Break Record
Dim HORIZ_PAGE_BREAK As HPAGE_BREAK_RECORD
HORIZ_PAGE_BREAK.opcode = 27
HORIZ_PAGE_BREAK.length = 2 + (xlsNumHorizPageBreaks * 2)
HORIZ_PAGE_BREAK.NumPageBreaks = xlsNumHorizPageBreaks
If xlsBufferSize Then
stat& = UpdateBuffer((HORIZ_PAGE_BREAK))
Else
Put #xlsFileNumber, , HORIZ_PAGE_BREAK
If ErrClear Then
Function = -1
Exit Function
End If
End If
'now write the actual page break values
For x& = 1 To UBound(xlsHorizPageBreakRows)
st$ = Mki$(xlsHorizPageBreakRows(x&))
If xlsBufferSize Then
stat& = UpdateBuffer(st$)
Else
Put #xlsFileNumber, , st$
If ErrClear Then
Function = -1
Exit Function
End If
End If
Next
End If
Dim END_FILE_MARKER As END_FILE_RECORD
'end of file marker
END_FILE_MARKER.opcode = 10
If xlsBufferSize Then
'set xlsBufferSize to -1 which will flag the UpdateBuffer routine
'to flush the buffer.
xlsBufferSize = -1
stat& = UpdateBuffer("")
End If
Put #xlsFileNumber, , END_FILE_MARKER
Close #xlsFileNumber
Function = 0 'return with no error code
End Function
Function xlsInsertHorizPageBreak(ByVal lrow As Long) As Long
'the row and column values are written to the excel file as
'unsigned integers. Therefore, must convert the longs to integer.
If lrow > 32767 Then
Row% = CInt(lrow - 65536)
Else
Row% = CInt(lrow) - 1 'rows/cols in Excel binary file are zero based
End If
xlsNumHorizPageBreaks = xlsNumHorizPageBreaks + 1
ReDim Preserve xlsHorizPageBreakRows(xlsNumHorizPageBreaks)
xlsHorizPageBreakRows(xlsNumHorizPageBreaks) = Row%
Function = 0
End Function
Function ConvertRow(ByVal lrow As Long) As Integer
'the row and column values are written to the excel file as
'integers. Therefore, must convert the longs to integer.
If lrow > 32767 Then
Function = CInt(lrow - 65536)
Else
Function = CInt(lrow) - 1 'rows/cols in Excel binary file are zero based
End If
End Function
Function ConvertCol(ByVal lcol As Long) As Integer
'the row and column values are written to the excel file as
'integers. Therefore, must convert the longs to integer.
If lcol > 32767 Then
Function = CInt(lcol - 65536)
Else
Function = CInt(lcol) - 1 'rows/cols in Excel binary file are zero based
End If
End Function
Function xlsWriteInteger(ByVal value%, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
'convert the row, col from LONG to INTEGER.
Row% = ConvertRow(lrow&)
Col% = ConvertCol(lcol&)
Dim INTEGER_RECORD As tInteger
INTEGER_RECORD.opcode = 2
INTEGER_RECORD.length = 9
INTEGER_RECORD.Row = Row%
INTEGER_RECORD.col = col%
INTEGER_RECORD.rgbAttr1 = CByt(HiddenLocked&)
INTEGER_RECORD.rgbAttr2 = CByt(CellFont& + CellFormat&)
INTEGER_RECORD.rgbAttr3 = CByt(CellAlignment&)
INTEGER_RECORD.intValue = value%
If xlsBufferSize Then
stat& = UpdateBuffer((INTEGER_RECORD))
Else
Put #xlsFileNumber, , INTEGER_RECORD
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0 'return with no error
End Function
Function xlsWriteNumber(ByVal value#, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
'convert the row, col from LONG to INTEGER.
Row% = ConvertRow(lrow&)
Col% = ConvertCol(lcol&)
Dim NUMBER_RECORD As tNumber
NUMBER_RECORD.opcode = 3
NUMBER_RECORD.length = 15
NUMBER_RECORD.Row = Row%
NUMBER_RECORD.col = col%
NUMBER_RECORD.rgbAttr1 = CByt(HiddenLocked&)
NUMBER_RECORD.rgbAttr2 = CByt(CellFont& + CellFormat&)
NUMBER_RECORD.rgbAttr3 = CByt(CellAlignment&)
NUMBER_RECORD.NumberValue = value#
If xlsBufferSize Then
stat& = UpdateBuffer((NUMBER_RECORD))
Else
Put #xlsFileNumber, , NUMBER_RECORD
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0 'return with no error
End Function
Function xlsWriteText(value$, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
'convert the row, col from LONG to INTEGER.
Row% = ConvertRow(lrow&)
Col% = ConvertCol(lcol&)
Dim b As Byte
st$ = value$
l& = Len(st$)
Dim TEXT_RECORD As tText
TEXT_RECORD.opcode = 4
TEXT_RECORD.length = 10
'Length of the text portion of the record
TEXT_RECORD.TextLength = l&
'Total length of the record
TEXT_RECORD.length = 8 + l&
TEXT_RECORD.Row = Row%
TEXT_RECORD.col = col%
TEXT_RECORD.rgbAttr1 = CByt(HiddenLocked&)
TEXT_RECORD.rgbAttr2 = CByt(CellFont& + CellFormat&)
TEXT_RECORD.rgbAttr3 = CByt(CellAlignment&)
'Put record header
If xlsBufferSize Then
stat& = UpdateBuffer((TEXT_RECORD))
Else
Put #xlsFileNumber, , TEXT_RECORD
End If
'Then the actual string data
For a& = 1 To l&
b = Asc(Mid$(st$, a&, 1))
If xlsBufferSize Then
stat& = UpdateBuffer(MkByt$(b))
Else
Put #xlsFileNumber, , b
If ErrClear Then
Function = -1
Exit Function
End If
End If
Next
Function = 0 'return with no error
End Function
Function xlsWriteDate(DateString$, ByVal lrow&, ByVal lcol&, ByVal CellFont&, ByVal CellAlignment&, ByVal HiddenLocked&, ByVal CellFormat&) As Long
'convert the row, col from LONG to INTEGER.
Row% = ConvertRow(lrow&)
Col% = ConvertCol(lcol&)
'convert the DateString$ from YYYYMMDD to a Julian date number
value&= (DateToJulian&(DateString$) - DateToJulian&("19000100")) + 1
Dim NUMBER_RECORD As tNumber
NUMBER_RECORD.opcode = 3
NUMBER_RECORD.length = 15
NUMBER_RECORD.Row = Row%
NUMBER_RECORD.col = col%
NUMBER_RECORD.rgbAttr1 = CByt(HiddenLocked&)
NUMBER_RECORD.rgbAttr2 = CByt(CellFont& + CellFormat&)
NUMBER_RECORD.rgbAttr3 = CByt(CellAlignment&)
NUMBER_RECORD.NumberValue = CDbl(value&)
If xlsBufferSize Then
stat& = UpdateBuffer((NUMBER_RECORD))
Else
Put #xlsFileNumber, , NUMBER_RECORD
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0 'return with no error
End Function
Function xlsSetMargin(ByVal Margin&, ByVal MarginValue#) As Long
'write the spreadsheet's layout information (in inches)
Dim MARGINRECORD As MARGIN_RECORD_LAYOUT
'Margin& should be one of the following....
'%xlsLeftMargin = 38
'%xlsRightMargin = 39
'%xlsTopMargin = 40
'%xlsBottomMargin = 41
MARGINRECORD.opcode = Margin&
MARGINRECORD.length = 8
MARGINRECORD.MarginValue = MarginValue# 'in inches
If xlsBufferSize Then
stat& = UpdateBuffer((MARGINRECORD))
Else
Put #xlsFileNumber, , MARGINRECORD
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0
End Function
Function xlsSetColumnWidth(ByVal FirstColumn&, ByVal LastColumn&, ByVal WidthValue&) As Long
Dim COLWIDTH As COLWIDTH_RECORD
COLWIDTH.opcode = 36
COLWIDTH.length = 4
COLWIDTH.col1 = CByt(FirstColumn&) - 1
COLWIDTH.col2 = CByt(LastColumn&) - 1
COLWIDTH.ColumnWidth = WidthValue& * 256 'values are specified as 1/256 of a character
If xlsBufferSize Then
stat& = UpdateBuffer((COLWIDTH))
Else
Put #xlsFileNumber, , COLWIDTH
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0
End Function
Function xlsSetFont(FontName$, ByVal FontHeight&, ByVal FontFormat&) As Long
'you can set up to 4 fonts in the spreadsheet file. When writing a value such
'as a Text or Number you can specify one of the 4 fonts (numbered 0 to 3)
Dim FONTNAME_RECORD As FONT_RECORD
l& = Len(FontName$)
FONTNAME_RECORD.opcode = 49
FONTNAME_RECORD.length = 5 + l&
FONTNAME_RECORD.FontHeight = FontHeight& * 20
FONTNAME_RECORD.FontAttributes1 = CByt(FontFormat&) 'bold/underline etc...
FONTNAME_RECORD.FontAttributes2 = CByt(0) 'reserved-always zero!!
FONTNAME_RECORD.FontNameLength = CByt(l&)
If xlsBufferSize Then
stat& = UpdateBuffer((FONTNAME_RECORD))
Else
Put #xlsFileNumber, , FONTNAME_RECORD
End If
'Then the actual font name data
Dim b As Byte
For a& = 1 To l&
b = Asc(Mid$(FontName$, a&, 1))
If xlsBufferSize Then
stat& = UpdateBuffer(MkByt$(b))
Else
Put #xlsFileNumber, , b
If ErrClear Then
Function = -1
Exit Function
End If
End If
Next
Function = 0
End Function
Function xlsSetHeader(HeaderText$) As Long
Dim HEADER_RECORD As HEADER_FOOTER_RECORD
l& = Len(HeaderText$)
HEADER_RECORD.opcode = 20
HEADER_RECORD.length = 1 + l&
HEADER_RECORD.TextLength = CByt(l&)
If xlsBufferSize Then
stat& = UpdateBuffer((HEADER_RECORD))
Else
Put #xlsFileNumber, , HEADER_RECORD
End If
'Then the actual Header text
Dim b As Byte
For a& = 1 To l&
b = Asc(Mid$(HeaderText$, a&, 1))
If xlsBufferSize Then
stat& = UpdateBuffer(MkByt$(b))
Else
Put #xlsFileNumber, , b
If ErrClear Then
Function = -1
Exit Function
End If
End If
Next
Function = 0
End Function
Function xlsSetFooter(FooterText$) As Long
Dim FOOTER_RECORD As HEADER_FOOTER_RECORD
l& = Len(FooterText$)
FOOTER_RECORD.opcode = 21
FOOTER_RECORD.length = 1 + l&
FOOTER_RECORD.TextLength = CByt(l&)
If xlsBufferSize Then
stat& = UpdateBuffer((FOOTER_RECORD))
Else
Put #xlsFileNumber, , FOOTER_RECORD
End If
'Then the actual Header text
Dim b As Byte
For a& = 1 To l&
b = Asc(Mid$(FooterText$, a&, 1))
If xlsBufferSize Then
stat& = UpdateBuffer(MkByt$(b))
Else
Put #xlsFileNumber, , b
If ErrClear Then
Function = -1
Exit Function
End If
End If
Next
Function = 0
End Function
Function xlsSetFilePassword(PasswordText$) As Long
Dim FILE_PASSWORD_RECORD As PASSWORD_RECORD
l& = Len(PasswordText$)
FILE_PASSWORD_RECORD.opcode = 47
FILE_PASSWORD_RECORD.length = l&
If xlsBufferSize Then
stat& = UpdateBuffer((FILE_PASSWORD_RECORD))
Else
Put #xlsFileNumber, , FILE_PASSWORD_RECORD
End If
'Then the actual Password text
Dim b As Byte
For a& = 1 To l&
b = Asc(Mid$(PasswordText$, a&, 1))
If xlsBufferSize Then
stat& = UpdateBuffer(MkByt$(b))
Else
Put #xlsFileNumber, , b
If ErrClear Then
Function = -1
Exit Function
End If
End If
Next
Function = 0
End Function
Function xlsPrintGridLines(ByVal TrueFalse&) As Long
Dim GRIDLINES_RECORD As PRINT_GRIDLINES_RECORD
GRIDLINES_RECORD.opcode = 43
GRIDLINES_RECORD.length = 2
If TrueFalse& = 0 Then
GRIDLINES_RECORD.PrintFlag = 0
Else
GRIDLINES_RECORD.PrintFlag = 1
End If
If xlsBufferSize Then
stat& = UpdateBuffer((GRIDLINES_RECORD))
Else
Put #xlsFileNumber, , GRIDLINES_RECORD
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0
End Function
Function xlsProtectSpreadsheet(ByVal TrueFalse&) As Long
Dim PROTECT_RECORD As PROTECT_SPREADSHEET_RECORD
PROTECT_RECORD.opcode = 18
PROTECT_RECORD.length = 2
If TrueFalse& = 0 Then
PROTECT_RECORD.Protect = 0
Else
PROTECT_RECORD.Protect = 1
End If
If xlsBufferSize Then
stat& = UpdateBuffer((PROTECT_RECORD))
Else
Put #xlsFileNumber, , PROTECT_RECORD
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0
End Function
Function xlsWriteDefaultFormats() As Long
Dim cFORMAT_COUNT_RECORD As FORMAT_COUNT_RECORD
Dim cFORMAT_RECORD As FORMAT_RECORD
Dim lIndex As Long
Dim aFormat(0 To 23) As String
Dim l As Long
Dim q As String
q = Chr$(34)
aFormat(0) = "General"
aFormat(1) = "0"
aFormat(2) = "0.00"
aFormat(3) = "#,##0"
aFormat(4) = "#,##0.00"
aFormat(5) = "#,##0\ " & q & "$" & q & ";\-#,##0\ " & q & "$" & q
aFormat(6) = "#,##0\ " & q & "$" & q & ";[Red]\-#,##0\ " & q & "$" & q
aFormat(7) = "#,##0.00\ " & q & "$" & q & ";\-#,##0.00\ " & q & "$" & q
aFormat(8) = "#,##0.00\ " & q & "$" & q & ";[Red]\-#,##0.00\ " & q & "$" & q
aFormat(9) = "0%"
aFormat(10) = "0.00%"
aFormat(11) = "0.00E+00"
aFormat(12) = "yyyy-mm-dd"
aFormat(13) = "dd/\ mmm\ yy"
aFormat(14) = "dd/\ mmm"
aFormat(15) = "mmm\ yy"
aFormat(16) = "h:mm\ AM/PM"
aFormat(17) = "h:mm:ss\ AM/PM"
aFormat(18) = "hh:mm"
aFormat(19) = "hh:mm:ss"
aFormat(20) = "dd/mm/yy\ hh:mm"
aFormat(21) = "##0.0E+0"
aFormat(22) = "mm:ss"
aFormat(23) = "@"
cFORMAT_COUNT_RECORD.opcode = &H1F
cFORMAT_COUNT_RECORD.length = &H2
cFORMAT_COUNT_RECORD.Count = CInt(UBound(aFormat))
If xlsBufferSize Then
stat& = UpdateBuffer((cFORMAT_COUNT_RECORD))
Else
Put #xlsFileNumber, , cFORMAT_COUNT_RECORD
End If
For lIndex = LBound(aFormat) To UBound(aFormat)
l = Len(aFormat(lIndex))
cFORMAT_RECORD.opcode = &H1E
cFORMAT_RECORD.length = l + 1
cFORMAT_RECORD.FormatLength = l
If xlsBufferSize Then
stat& = UpdateBuffer((cFORMAT_RECORD))
Else
Put #xlsFileNumber, , cFORMAT_RECORD
End If
'Then the actual format
Dim b As Byte, a As Long
For a = 1 To l
b = Asc(Mid$(aFormat(lIndex), a, 1))
If xlsBufferSize Then
stat& = UpdateBuffer(MkByt$(b))
Else
Put #xlsFileNumber, , b
If ErrClear Then
Function = -1
Exit Function
End If
End If
Next
Next
Function = 0
End Function
Function xlsSetDefaultRowHeight(ByVal HeightValue&) As Long
'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 function takes a HeightValue such as
'14 point and converts it the correct size before writing it to the file.
Dim DEFHEIGHT As DEF_ROWHEIGHT_RECORD
DEFHEIGHT.opcode = 37
DEFHEIGHT.length = 2
DEFHEIGHT.RowHeight = HeightValue& * 20 'convert points to 1/20ths of point
If xlsBufferSize Then
stat& = UpdateBuffer((DEFHEIGHT))
Else
Put #xlsFileNumber, , DEFHEIGHT
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0
End Function
Function xlsSetRowHeight(ByVal lrow&, ByVal HeightValue&) As Long
'convert the row, col from LONG to INTEGER.
Row% = ConvertRow(lrow&)
'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 function takes a HeightValue such as
'14 point and converts it the correct size before writing it to the file.
Dim ROWHEIGHTREC As ROW_HEIGHT_RECORD
ROWHEIGHTREC.opcode = 8
ROWHEIGHTREC.length = 16
ROWHEIGHTREC.RowNumber = Row%
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
If xlsBufferSize Then
stat& = UpdateBuffer((ROWHEIGHTREC))
Else
Put #xlsFileNumber, , ROWHEIGHTREC
If ErrClear Then
Function = -1
Exit Function
End If
End If
Function = 0
End Function
Function DateToJulian&(DateString$) As Long
'DateString$ must be in YYYYMMDD
Local Elapsed As Long
If Len(DateString$) <> 8 Then
Function = 0
Exit Function
End If
Year& = Val(Left$(DateString$, 4))
month& = Val(Mid$(DateString$, 5, 2))
day& = Val(Right$(DateString$, 2))
If month& < 3 Then ' January or February?
month& = month& + 12 ' 13th or 14th month ....
Decr year& ' .... of prev. year
End If
Elapsed = Int((year& + 4712) * 365.25) ' years elapsed
Elapsed = Elapsed - (year& \ 100) ' substract century leapdays
Elapsed = Elapsed + (year& \ 400) ' re-add valid ones
Elapsed = Elapsed + _
Int(30.6 * (month& - 1) + .2) ' months elapsed + adjustm.
Function = Elapsed + day& ' days of final month
End Function
Function CTOD$(PBDate As String)
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'Converts a PowerBASIC formated date string into an xBase date
' Usage: ans$ = CTOD("12-13-2001")
' ans$ = "20011213"
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'First parse PBDate
Dim month$, day$, year$
Dim ChekYear&
month$ = Parse$(PBDate, Any "-", 1) 'month
day$ = Parse$(PBDate, Any "-", 2) 'day
year$ = Parse$(PBDate, Any "-", 3) 'year
ChekYear& = Val(year$)
' Adjust if user enters only 2 digit year
If ChekYear& < 80 Then 'assume we've rolled into the next century
year$ = "20" + year$
ElseIf ChekYear& < 100 Then 'between 1980 and 1999
year$ = "19" + year$
End If
' Force the reformat of strings into proper xBase length.
month$ = Format$(Val(month$), "00")
day$ = Format$(Val(day$), "00")
year$ = Format$(Val(year$), "0000")
Function = (year$ & month$ & day$)
End Function
Function xlsBuffer(ByVal TrueFalse&, ByVal BufferSize&) As Long
If BufferSize& <= 0 Then Exit Function
If TrueFalse& <> 0 Then
xlsBufferSize = BufferSize& 'flag that buffer is active & also contains the buffer size
xlsBufferString$ = Space$(xlsBufferSize)
End If
End Function
Function UpdateBuffer(BufferData$) As Long
Static CurBufferPos&
'if xlsBufferSize equals -1 then the flag to flush the buffer has
'been set and the file is about to be closed.
If xlsBufferSize = -1 Then
Put$ xlsFileNumber, Left$(xlsBufferString$, CurBufferPos&)
'reset the buffer so old data does not get carried forward
'to any new file being created.
xlsBufferString$ = ""
CurBufferPos& = 0
Exit Function
End If
'if the current data would be too big for the buffer then flush
'the buffer and reset its size.
If Len(BufferData$) + CurBufferPos& > xlsBufferSize& Then
Put$ xlsFileNumber, Left$(xlsBufferString$, CurBufferPos&)
CurBufferPos& = 0
End If
'write the data to the buffer and update the buffer size indicator
Mid$(xlsBufferString$, CurBufferPos& + 1) = BufferData$
CurBufferPos& = CurBufferPos& + Len(BufferData$)
End FunctionCode: Select all
#COMPILE EXE
#INCLUDE "Excel.inc"
%XLSFALSE = 0
%XLSTRUE = NOT %XLSFALSE
FUNCTION PBMAIN() AS LONG
starttime! = TIMER
'enable the buffer. This is optional, but enabling a buffer will speed
'up file access.
stat& = xlsBuffer(%XLSTRUE, (512 * 1024)) 'a 512K buffer
'Create the new spreadsheet
mFileName$ = ".\vbtest.xls" 'create spreadsheet in the current directory
stat& = xlsCreateFile(mFileName$)
'stat& returns non-zero if an error occured.
'set a Password for the file. If set, the rest of the spreadsheet will
'be encrypted. If a password is used it must immediately follow the
'xlsCreateFile function call.
'This is different then protecting the spreadsheet (see below).
'NOTE: For some reason this function does not work. Excel will
'recognize that the file is password protected, but entering the password
'will not work. Also, the file is not encrypted. Therefore, do not use
'this function until I can figure out why it doesn't work. There is not
'much documentation on this function available.
'stat& = xlsSetFilePassword("whatever")
'specify whether to print the gridlines or not
'this should come before the setting of fonts and margins
stat& = xlsPrintGridLines(%XLSTRUE)
'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.
stat& = xlsSetMargin(%xlsTopMargin, 1.5) 'set to 1.5 inches
stat& = xlsSetMargin(%xlsLeftMargin, 1.5)
stat& = xlsSetMargin(%xlsRightMargin, 1.5)
stat& = xlsSetMargin(%xlsBottomMargin, 1.5)
'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.
stat& = xlsSetFont("Arial", 10, %xlsNoFormat) 'font0
stat& = xlsSetFont("Arial", 10, %xlsBold) 'font1
stat& = xlsSetFont("Arial", 10, %xlsBold + %xlsUnderline) 'font2
stat& = xlsSetFont("Courier", 18, %xlsItalic) 'font3
'Column widths are specified in Excel as 1/256th of a character.
stat& = xlsSetColumnWidth(1, 1, 50)
'set the global row height for the entire spreadsheet
stat& = xlsSetDefaultRowHeight(16)
'set the height of the first two rows a little bigger to allow for the
'title of the spreadsheet.
stat& = xlsSetRowHeight(1, 24)
stat& = xlsSetRowHeight(2, 24)
'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.
stat& = xlsSetHeader("This is the header")
stat& = xlsSetFooter("This is the footer")
'write some data to the spreadsheet
stat& = xlsWriteInteger(20, 6, 1, %xlsFont0, %xlsLeftAlign, %xlsCellNormal, 0)
'write a cell with a shaded number with a bottom border
stat& = xlsWriteNumber(12123.456, 7, 1, %xlsFont1, %xlsrightAlign + %xlsBottomBorder + %xlsShaded, %xlsCellNormal, 0)
'write a normal left aligned string using font2 (bold & underline)
stat& = xlsWriteText("This is a test string", 8, 1, %xlsFont2, %xlsLeftAlign, %xlsCellNormal, 0)
'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!!!
stat& = xlsWriteText("This cell is locked.", 9, 1, %xlsFont3, %xlsLeftAlign, %xlsCellLocked, 0)
'fill the cell with "F"'s
stat& = xlsWriteText("F", 10, 1, %xlsFont3, %xlsFillCell, %xlsCellNormal, 0)
'write a hidden cell to the spreadsheet. This only works for cells
'that contain formulae. Text, Number, Integer value text can not be hidden
'using this feature. It is included here for the sake of completeness.
stat& = xlsWriteText("If this were a formula it would be hidden!", 11, 1, %xlsFont0, %xlsCentreAlign, %xlsCellHidden, 0)
'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. The date will be eventually written as a number after conversion to a
'Julian date number.
'Write todays date..... Use format #12 mm/dd/yy (you can change the different formats by modifying
'the code in xlsWriteDefaultFormats. The date is expected to be in the YYYYMMDD format. You can convert
'from mm-dd-yyyy format to YYYYMMDD by calling the CTOD$ function.
mDate$ = CTOD$(DATE$)
stat& = xlsWriteDate(mDate$, 15, 1, %xlsFont1, %xlsLeftAlign, %xlsCellNormal, 12)
mDate$ = "19991128"
stat& = xlsWriteDate(mDate$, 16, 1, %xlsFont1, %xlsLeftAlign, %xlsCellNormal, 13)
mDate$ = "20000331"
stat& = xlsWriteDate(mDate$, 17, 1, %xlsFont1, %xlsLeftAlign, %xlsCellNormal, 14)
mDate$ = "20010630"
stat& = xlsWriteDate(mDate$, 18, 1, %xlsFont1, %xlsLeftAlign, %xlsCellNormal, 15)
mDate$ = "19991023"
stat& = xlsWriteDate(mDate$, 19, 1, %xlsFont1, %xlsLeftAlign, %xlsCellNormal, 20)
'insert a page break
stat& = xlsInsertHorizPageBreak(20)
'write consecutive numbers in the column
'This demonstrates that this Excel code can exceed the normal BIFF 2.1 and Excel 95 row limit
'of 32,767 rows.
NumRows& = 50000
FOR x# = 1 TO NumRows&
stat& = xlsWriteNumber(x#, 20+x#, 1, %xlsFont1, %xlsLeftAlign, %xlsCellNormal, 0)
NEXT
'PROTECT the spreadsheet so any cells specified as LOCKED will not be
'overwritten. Also, all cells with HIDDEN set will hide their formulae.
'PROTECT does not use a password.
stat& = xlsProtectSpreadsheet(%XLSTRUE)
'Finally, close the spreadsheet
stat& = xlsCloseFile
endtime! = TIMER
MSGBOX "Excel BIFF Spreadsheet created (" & TRIM$(FORMAT$(endtime!-starttime!, "###.####")) & " seconds)" & $CrLf & "Filename: " & mFileName$,, "Excel API"
END FUNCTIONhttp://sc.openoffice.org/excelfileformat.pdf
- np