mrfitness


I am having trouble with copying numeric values with decimal places into excel.
I have a select statement (some being sums of numeric fields with 2 decimal places) with a group by function and I place these results in cursor c1.
When it tries to enter this value into excel, it rounds all values up. (eg 309.66 becomes 310)
I tried changing the format of the excel file to numeric with 2 decimal places BEFORE I ran the code but it still rounded up showing 2 decimal places (310.00)
I then tried changing the structure of the fields in the table to character instead of numeric - still rounds up.
Is there a way around this when using a cursor I would rather not have the query copy to a table as this is part of a huge loop that would end up creating too many tables.
Below is a sample of how I am entering the data:

loExcelTemplate = Createobject("Excel.Application")
esheet = 1

With loExcelTemplate
.workbooks.Open("C:\test.xls")
ln2Col = 2
SCAN
.sheets[esheet].cells(ln2Col,2).Value = alltrim(str(c1.tot_rev))



Re: Copying a numeric value with decimals from a cursor into excel without rounding up

Naomi Nosonovsky


Did you try to set NumberFormat for the column

Here is a function from Gregory Adam which may give you some ideas:

Code Snippet

function VariableToExcel(Content, FieldType, CellReference)

local Success
Success = TRUE

local x, FormatMask

FieldType = iif(empty(m.FieldType), vartype(m.Content), m.FieldType)
x = null

do case
case isnull(m.Content)

case inlist(m.FieldType, T_CHARACTER, T_MEMO)
x = ['] + rtrim(m.Content)

case inlist(m.FieldType, T_DATE)
x = iif(empty(m.Content), '', '=date(' + transform(dtos(m.Content), '@R 9999,99,99') + ')')
FormatMask = 'dd/mm/yyyy'

case inlist(m.FieldType, T_DATETIME)
x = ;
iif(empty(m.Content), ;
'', ;
'=date(' + transform(dtos(m.Content), '@R 9999,99,99') + ')' ;
+ '+time(' + transform(right(ttoc(m.Content,1),6), '@R 99,99,99') + ')' ;
)
FormatMask = 'dd/mm/yyyy hh:mm:ss'

case inlist(m.FieldType, T_CURRENCY)
x = m.Content
FormatMask = '#,###.00' + '_);[Red](' + '#,###.00' + ')'

case inlist(m.FieldType, 'I')
x = m.Content
FormatMask = '#,###' + '_);[Red](' + '#,###' + ')'

case inlist(m.FieldType, T_NUMERIC, T_DOUBLE)
x = m.Content
FormatMask = '#,###.00' + '_);[Red](' + '#,###.00' + ')'

case inlist(m.FieldType, T_LOGICAL)
x = iif(m.Content, 'TRUE', 'FALSE')

endcase

do case
case (vartype(m.CellReference) <> T_OBJECT)
Success = FALSE

case isnull(m.x)
x = ''

otherwise
with m.CellReference
.Value = m.x

if( !empty(m.FormatMask) )
.NumberFormat = m.FormatMask
endif
endwith
endcase

return m.Success
endfunc
*--------------------------------------------------------------------------






Re: Copying a numeric value with decimals from a cursor into excel without rounding up

CetinBasoz

.Value = ...

is not a good style to fill in excel values and would be slow but it would work with small amount of transfers.

Second with numeric values you shouln't pass them as strings but numbers.

Third, assuming passing as strings was a good way, your conversion expression is the one making the roundation. See str() in help.

str(123.655)

str(123.655,10,2)

str(123.655,10,5)






Re: Copying a numeric value with decimals from a cursor into excel without rounding up

mrfitness

As I stated previously, I had tried to set the excel columns to number format with 2 decimals but all that would do would change the '310' to '310.00'

The code you gave me was interesting but I am not sure how it could help in my situation.

I have a select statement below. Is there anything I can add (possible from your code below) to carry over the decimals from the cursor when copying into excel :
select contractno,sum(total_rev) as tot_rev, sum(total_base) as tot_base,sum(list_2010) as
totlst2010, count(*) as ships, ;
from foxytest group by 1 where contractno = "0100026" into cursor c1

Copy File "C:\temp.xls" TO "C:\test.xls"
loExcelTemplate = Createobject("Excel.Application")
esheet = 1

With loExcelTemplate

.workbooks.Open("C:\test.xls")

.Visible=.F.

&&FILLING IN TITLES FOR EACH FIELD
.sheets[esheet].cells(1,1).Value = "Contractno"
.sheets[esheet].cells(1,2).Value = "Total_rev"
.sheets[esheet].cells(1,3).Value = "Total_base"
.sheets[esheet].cells(1,4).Value = "Total_lst"
.sheets[esheet].cells(1,5).Value = "Ships"


ln2Col = 2
SCAN
&&FILL IN VALUES OF LENGTHS FOR THE FIELD IN THE CURSOR
.sheets[esheet].cells(ln2Col,1).Value = alltrim("0"+Alltrim(c1.contractno))
.sheets[esheet].cells(ln2Col,2).Value = alltrim(str(c1.tot_rev))
.sheets[esheet].cells(ln2Col,3).Value = Alltrim(str(c1.tot_base))
.sheets[esheet].cells(ln2Col,4).Value = Alltrim(str(c1.totlst))
.sheets[esheet].cells(ln2Col,5).Value = Alltrim(str(c1.ships))
ln2Col = ln2Col+ 1

ENDSCAN

Endwith




Re: Copying a numeric value with decimals from a cursor into excel without rounding up

Naomi Nosonovsky

Good point! I didn't notice that the thread originator was using STR()



Re: Copying a numeric value with decimals from a cursor into excel without rounding up

mrfitness

Ok I will look into that...I am using VFP6 and I don't have a help library Sad




Re: Copying a numeric value with decimals from a cursor into excel without rounding up

Naomi Nosonovsky

See Cetin's answer. Why do you use alltrim(str( and not just value

And also why do you need to use Automation in this case if you don't seem to apply anything

In you case COPY TO MyExcelFile TYPE XLS should work and you may simply apply additional formating later with Ole Automation. I have a function DBFToExcel based on this idea. First I put file into Excel with COPY TO and then apply extra formatting.





Re: Copying a numeric value with decimals from a cursor into excel without rounding up

mrfitness

Ok the alltrim(str(c1.tot_rev,10,2)) worked, thanks...you are saying there is a better way to do this instead of using value Any idea where I can get the help library for VFP6





Re: Copying a numeric value with decimals from a cursor into excel without rounding up

mrfitness

This is only a sample....I am using a database that will have hundreds of thousands of records....with thousands of unique contracts (which is what I am grouping on in the select statement)
The value I showed you in the where clause is actually a variable that will change with each pass in the loop. Each time I will create an excel file named after the variable in each pass...not 'test.xls'
However I am interested in seeing your function....it might be easier to copy each select into a table, run the function on that table,then delete it




Re: Copying a numeric value with decimals from a cursor into excel without rounding up

Naomi Nosonovsky

Do you have VFP disk somewhere I can not imagine working without Help, it is so hard Sad And now without intellisense.



Re: Copying a numeric value with decimals from a cursor into excel without rounding up

mrfitness

I don't have the disk handy on me...I am working out of the office...but I did install everything on the disk...I do not think it came with a library Sad

It is very frustrating as I am getting another error that is hard to tackle...but I will have to start a new thread for that!




Re: Copying a numeric value with decimals from a cursor into excel without rounding up

Naomi Nosonovsky

Hi,

For each cursor you created you can create a separate Excel file using COPY TO command. There are lots of other ways to move big chunk of data to Excel, DataToClip method for one, VFP2Excel code posted here by Cetin - two. I use Cetin's code when I need to copy memo fields, works great.

Bellow I'm posting my function as is. It uses TRY/CATCH, you may need to switch to ON ERROR instead for VFP6.

Code Snippet

************************************************************
* FUNCTION DBFToExcel()
************************************************************
* Author............: Nadya Nosonovsky
*) Description.......: Creates an Excel file from open table / cursor
* Calling Samples...: DbfToExcel(m.lcXLSFile, @laHeader_Info, "Batch Statistics")
* Parameter List....: tcXLSFileName, taHeader_Info, tcTitle, tcPassword, tlLockHeaderRow
* Major change list.:
FUNCTION DBFToExcel
LPARAMETERS tcXLSFileName, taHeader_Info, tcTitle, tcPassword, tlLockHeaderRow
EXTERNAL ARRAY taHeader_Info
* This function assumes, that the output table (cursor) is currently opened
*-- Generate output to XLS File
* -- Do some basic parameter checking
IF EMPTY(ALIAS())
RETURN "No table/cursor is currently opened to process."
ENDIF

IF EMPTY(m.tcXLSFileName)
RETURN "Excel file name is not passed."
ENDIF

IF TYPE("taHeader_Info[1]") <> "C"
RETURN "Array taHeader_Info is not passed."
ENDIF

IF VARTYPE(m.tcTitle) <> "C"
RETURN "Excel title is not passed."
ENDIF

LOCAL loExcel, lni, loSheet, lnK, lcError, lnLines, ;
lnActualFields, lnHeaderCells, lcRange, lcStart, lcEnd, lnCols, lnoffset
lcError = ""

LOCAL ARRAY laTitle[1]

IF NOT EMPTY(m.tcTitle)
lnLines = ALINES(laTitle, m.tcTitle)
lnoffset = 2
ELSE
lnLines = 0
lnoffset = 1
ENDIF

#include Excel.h
#DEFINE xlPart 2

TRY
lnActualFields = FCOUNT()
lnHeaderCells = ALEN(taHeader_Info,1)
COPY TO (m.tcXLSFileName) TYPE XL5
*-- Create Ole Automation with Excel
loExcel = CREATEOBJECT("Excel.Application")
*-- Open XLS File
loExcel.APPLICATION.WorkBooks.OPEN(m.tcXLSFileName)

loExcel.DisplayAlerts = .F.

FOR lni = 1 TO loExcel.APPLICATION.APPLICATION.WorkBooks(1).Sheets.COUNT
*-- Select individual sheets from open XLS File
loSheet = loExcel.APPLICATION.APPLICATION.WorkBooks(1).Sheets(m.lni)

** Delete the column headers from Excel (first row)
loSheet.ROWS("1").DELETE(xlShiftDown)

** Insert lines with Title + 1 or 2 empty rows for the column headers
loSheet.ROWS("1:" + ALLTRIM(STR(m.lnLines + m.lnoffset))).INSERT(xlShiftDown)

IF m.lnLines > 0 && Title font
WITH loSheet.RANGE("1:" + ALLTRIM(STR(m.lnLines))).FONT
.COLOR = 8388736 && rgb(255,0,0)
.SIZE = 14
.Bold = .T.
.NAME = 'Tahoma'
ENDWITH
ENDIF
** Header font
WITH loSheet.RANGE(ALLTRIM(STR(m.lnLines + 1)) + ;
":" + ALLTRIM(STR(m.lnLines + m.lnoffset))).FONT
* .Color = Rgb(255,0,0)
.SIZE = 11
.Bold = .T.
.NAME = 'Tahoma'
ENDWITH

*!* With loSheet.Range("1:2").Borders
*!* .Weight = xlMedium
*!* .LineStyle = xlContinuous
*!* Endwith
FOR lnK = 1 TO m.lnLines
loSheet.Cells(m.lnK, 1).VALUE = laTitle[m.lnK]
NEXT

FOR lnK = 1 TO m.lnHeaderCells
loSheet.Cells(m.lnoffset + m.lnLines, m.lnK).VALUE = ;
taHeader_Info[m.lnK,1] + ;
IIF(EMPTY(taHeader_Info[m.lnK,2]), "", ;
CHR(10) + taHeader_Info[m.lnK,2])
* loSheet.Cells(3 + m.lnLines,m.lnK).value = taHeader_Info[m.lnK,2]

IF !EMPTY(taHeader_Info[m.lnK,3]) && There is format information
loRange = loSheet.UsedRange.Offset(m.lnLines + m.lnoffset) && we don't want to apply format for header rows
loRange.COLUMNS[m.lnK].NumberFormat = taHeader_Info[m.lnK,3]
ENDIF

IF !EMPTY(taHeader_Info[m.lnK,4]) && There is Column Width
loSheet.COLUMNS[m.lnK].SELECT
loSheet.COLUMNS[m.lnK].COLUMNWIDTH = taHeader_Info[m.lnK,4]
ELSE
loSheet.COLUMNS[m.lnK].AUTOFIT()
ENDIF
NEXT
NEXT

IF m.lnHeaderCells > m.lnActualFields
lnCols = m.lnActualFields + 1
** Code from Sergey Berezniker
lcStart = IIF(m.lnCols>26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ;
CHR(((m.lnCols - 1) % 26) + 65)
lnCols = m.lnHeaderCells
lcEnd = IIF(m.lnCols > 26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ;
CHR(((m.lnCols - 1) % 26) + 65)
lcRange = m.lcStart + ALLTRIM(STR(m.lnLines + m.lnoffset)) + ":" + ;
m.lcEnd + ALLTRIM(STR(m.lnLines + m.lnoffset))

WITH loSheet.RANGE(m.lcRange).Interior
.ColorIndex = 33 && Blue Color
.PATTERN = xlSolid
.PatternColorIndex = xlAutomatic
ENDWITH
ELSE
lnCols = m.lnActualFields
lcEnd = IIF(m.lnCols > 26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ;
CHR(((m.lnCols - 1) % 26) + 65)
ENDIF

** Make the Totals row in bold and Green highlight
loExcel.RANGE([A1], loExcel.SELECTION.SpecialCells(xlLastCell)).SELECT
loExcel.SELECTION.FormatConditions.DELETE
loExcel.SELECTION.FormatConditions.ADD(xlExpression,, '=UPPER(Left($A1,5))="TOTAL"')

WITH loExcel.SELECTION.FormatConditions(1)
.FONT.Bold = .T.
.Interior.ColorIndex = 4
ENDWITH

** Now apply borders to each header cell
lcRange = "A" + ALLTRIM(STR(m.lnLines + m.lnoffset)) + ":" + ;
m.lcEnd + ALLTRIM(STR(m.lnLines + m.lnoffset))

WITH loSheet.RANGE(m.lcRange)
WITH .BORDERS(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
ENDWITH
WITH .BORDERS(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
ENDWITH
WITH .BORDERS(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
ENDWITH
WITH .BORDERS(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
ENDWITH
WITH .BORDERS(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
ENDWITH
ENDWITH

IF m.tlLockHeaderRow && we need to prevent headers from modifying
** Code from Borislav Borissov
loSheet.UsedRange.SELECT
loExcel.SELECTION.Locked = .F. && First we need to UNLOCK all cells
loExcel.ROWS(m.lnLines + m.lnoffset).SELECT && Select the header row of the sheet
loExcel.SELECTION.Locked = .T. && Lock Cells in the header row
loExcel.ActiveWorkbook.ActiveSheet.PROTECT(,.T.,,.T.)
ENDIF

loExcel.RANGE([A1]).SELECT && So we would not end up with whole file selected
IF NOT EMPTY(m.tcPassword)
loExcel.ActiveWorkbook.PASSWORD = m.tcPassword && Works in Excel 2003
ENDIF

loExcel.SAVE()

CATCH TO loError
lcError = Log_Error(m.loError)
FINALLY
IF VARTYPE(m.loExcel) = 'O'
loExcel.QUIT
RELEASE loExcel
ENDIF
ENDTRY

RETURN m.lcError
ENDFUNC





Re: Copying a numeric value with decimals from a cursor into excel without rounding up

mrfitness

How can I use the COPY TO command with the cursor




Re: Copying a numeric value with decimals from a cursor into excel without rounding up

mrfitness

How can I use the COPY TO command with the cursor

Naomi Nosonovsky wrote:

See Cetin's answer. Why do you use alltrim(str( and not just value

And also why do you need to use Automation in this case if you don't seem to apply anything

In you case COPY TO MyExcelFile TYPE XLS should work and you may simply apply additional formating later with Ole Automation. I have a function DBFToExcel based on this idea. First I put file into Excel with COPY TO and then apply extra formatting.





Re: Copying a numeric value with decimals from a cursor into excel without rounding up

Naomi Nosonovsky

It works the same way with cursors as for tables. At least in VFP8 it does.

select * ... into cursor curTest

copy to myExcelFile type XLS