METHOD ToExcel( bProgress ) CLASS TReport
#define xlCellTypeLastCell 11
#define xlThin 2
#define xlSolid 1
#define xlCenter -4108
#define xlBottom -4107
#define xlTop -4160
#define xlRight -4152
#define xlLeft -4131
#define xlNone -4142
#define xlContinuous 1
#define xlAutomatic -4105
#define xlExpression 2
#define xlEdgeBottom 9
#define xlEdgeTop 8
#define xlEdgeLeft 7
#define xlEdgeRight 10
#define xlHairLine 1
#define xlThick 4
#define xlMedium -4138
#define xlUnderlineStyleSingle 2
local oExcel, oBook, oSheet, oRange
local nRow, nFirstRow, nLastRow
local nCols, nCol, nLines, nLine, oCol, cPic, cAdr, nFont, aFont
local aValues //, aMemos := {}, aPics := {}
local lTotal := .f., lMemo := .t.
local nRowHeight, nMemoHeight
local nMergeCols
local lGroup, nGroups, aGrpVal, aGrpFtr, aGrpRow, nGrp, cGrp, oRng
local nDataRows := 0
// FIX para forzar el DbGoTop() sin tocar los prgs
if ::bSkip = Nil
dbgotop()
endif
oExcel := ExcelObj()
if oExcel == nil
MsgAlert( "Excel not installed" )
return self
endif
oBook := oExcel:WorkBooks:Add()
oSheet := oBook:ActiveSheet
nCols := Len( ::aColumns )
nMergeCols := nCols // columns that can be merged for group headings
oRange := oSheet:Range( oSheet:Columns( 1 ), oSheet:Columns( nCols ) )
DEFAULT ::bFor := { || .t. }, ::bWhile := { || ! eof() }
::Init()
::xlSetFont( oSheet:Cells, ::aFont[ 1 ] )
oSheet:Cells:VerticalAlignment := xlTop
nRowHeight := oSheet:Rows( 1 ):RowHeight
::xlHeader( oSheet:PageSetup )
::xlFooter( oSheet:PageSetup )
aValues := Array( nCols )
aFont := Array( nCols )
lGroup := ( nGroups := Len( ::aGroups ) ) > 0
if lGroup
aGrpVal := Array( nGroups )
aGrpFtr := Array( nGroups )
aGrpRow := Array( nGroups )
endif
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
aFont[ nCol ] := Eval( oCol:bDataFont )
if aFont[ nCol ] > 1
::xlSetFont( oSheet:Columns[ nCol ], ::aFont[ aFont[ nCol ] ] )
endif
if oCol:lMemo .or. oCol:lImage
oSheet:Columns( nCol ):ColumnWidth := If( Empty( oCol:nSize ), 20, oCol:nSize )
endif
if oCol:lMemo
oSheet:Columns( nCol ):WrapText := .t.
lMemo := .t.
endif
next
// Column Headers
nRow := Len( ::oTitle:aLine ) + 1
nLines := 1
AEval( ::aColumns, { |o| nLines := Max( nLines, Len( o:aTitle ) ) } )
WITH OBJECT oRange:Rows( nRow ):Borders( xlEdgeTop )
:LineStyle := xlContinuous // 1
:Weight := xlMedium
END
for nLine := 1 to nLines
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
if Len( oCol:aTitle ) >= nLine
aValues[ nCol ] := Eval( oCol:aTitle[ nLine ] )
else
aValues[ nCol ] := nil
endif
if ( nFont := Eval( oCol:bTitleFont ) ) != aFont[ nCol ]
::xlSetFont( oRange:Cells( nRow, nCol ), ::aFont[ nFont ] )
endif
next nCol
oRange:Rows( nRow ):Value := aValues
nRow++
next nLine
WITH OBJECT oRange:Rows( nRow - 1 ):Borders( xlEdgeBottom )
:LineStyle := xlContinuous // 1
:Weight := xlThin
END
nRow++
cAdr := oSheet:Range( oSheet:Rows( 1 ), oSheet:Rows( nRow ) ):Address
oSheet:PageSetUp:PrintTitleRows := cAdr
// Column formats
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
cPic := oCol:aPicture[ 1 ]
WITH OBJECT oRange:Columns( nCol )
:HorizontalAlignment := If( oCol:nPad == RPT_CENTER, -4108, If( oCol:nPad == RPT_RIGHT, -4152, -4131 ) )
SWITCH ValType( Eval( oCol:aData[ 1 ] ) )
case 'C'
oRange:Columns( nCol ):NumberFormat := "@"
exit
case 'N'
:NumberFormat := "##0"
:HorizontalAlignment := xlRight
if "." $ cPic
:NumberFormat += SubStr( cPic, At( ".", cPic ) )
endif
if "," $ cPic
:NumberFormat := "#," + :NumberFormat
endif
exit
case 'D'
:HorizontalAlignment := xlRight
END
END
next
nLines := 1
AEval( ::aColumns, { |o,i| nLines := Max( nLines, Len( o:aData ) ), ;
If( o:lTotal, ( lTotal := .t., If( nMergeCols >= i, ;
nMergeCols := i - 1, nil ) ), nil ) } )
// Main Data
nFirstRow := nRow
nLastRow := nRow - 1
do while Eval( ::bWhile )
if Eval( ::bFor )
// Handle Groups
if lGroup
nLastRow := nRow - 1
// check ending of groups
for nGrp := nGroups to 1 step -1
cGrp := Eval( ::aGroups[ nGrp ]:bGroup )
if cGrp != aGrpVal[ nGrp ]
if aGrpVal[ nGrp ] != nil
WITH OBJECT ( oRng := oSheet:Range( oRange:Cells( nRow, 1 ), oRange:Cells( nRow, nMergeCols ) ) )
:MergeCells := .t.
:Value := aGrpFtr[ nGrp ]
if nGrp > 1
:InsertIndent( nGrp - 1 )
endif
END
nFont := Eval( ::aGroups[ nGrp ]:bFootFont )
if nFont != aFont[ 1 ]
::xlSetFont( oRng, ::aFont[ nFont ] )
endif
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
if oCol:lTotal
cAdr := oSheet:Range( oSheet:Cells( aGrpRow[ nGrp ], nCol ), ;
oSheet:Cells( nLastRow, nCol ) ):Address( .f., .f. )
oSheet:Cells( nRow, nCol ):Formula := "=SUBTOTALES(9;" + cAdr + ")"
nFont := Eval( oCol:bTotalFont )
if nFont != aFont[ nCol ]
::xlSetFont( oSheet:Cells( nRow, nCol ), ::aFont[ nFont ] )
endif
endif
next nCol
nRow++
endif // if aGrpVal[ nGrp ] != nil
aGrpRow[ nGrp ] := nil // this group ended
aGrpVal[ nGrp ] := cGrp // retain the new value
endif // change in group value
next nGrp
// check start of groups
for nGrp := 1 to nGroups
if aGrpRow[ nGrp ] == nil // start this group
WITH OBJECT ( oRng := oSheet:Range( oRange:Cells( nRow, 1 ), oRange:Cells( nRow, nMergeCols ) ) )
:MergeCells := .t.
:Value := Eval( ::aGroups[ nGrp ]:bHeader )
if nGrp > 1
:InsertIndent( nGrp - 1 )
endif
END
nFont := Eval( ::aGroups[ nGrp ]:bHeadFont )
if nFont != aFont[ 1 ]
::xlSetFont( oRng, ::aFont[ nFont ] )
endif
nRow++
endif
next nGrp
for nGrp := 1 to nGroups
if aGrpRow[ nGrp ] == nil
aGrpRow[ nGrp ] := nRow // memorize the start row of group
endif
next
endif // if lGroup
// normal data
for nLine := 1 to nLines
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
if Len( oCol:aData ) >= nLine .and. !oCol:lImage
aValues[ nCol ] := Eval( oCol:aData[ nLine ] )
if ValType( aValues[ nCol ] ) == 'C'
aValues[ nCol ] := Trim( aValues[ nCol ] )
endif
else
aValues[ nCol ] := nil
endif
if ( nFont := Eval( oCol:bDataFont ) ) != aFont[ nCol ]
::xlSetFont( oRange:Cells( nRow, nCol ), ::aFont[ nFont ] )
endif
next
oRange:Rows( nRow ):Value := aValues
// Handle Memo Height in multi-line report
if lMemo .and. nLines > 1
if nLine == 1
nMemoHeight := oSheet:Rows( nRow ):RowHeight
oSheet:Rows( nRow ):RowHeight := nRowHeight
endif
if nLine == nLines
for nCol := 1 to nCols
if ::aColumns[ nCol ]:lMemo
oSheet:Range( oSheet:Cells( nRow - nLines + 1, nCol ), ;
oSheet:Cells( nRow, nCol ) ):MergeCells := .t.
if nMemoHeight > nLines * nRowHeight
oSheet:Rows( nRow ):RowHeight := nMemoHeight - ( nLines - 1 ) * nRowHeight
endif
endif
next
endif
endif
nRow++
next
endif
// group footers
if lGroup
for nGrp := 1 to nGroups
aGrpFtr[ nGrp ] := Eval( ::aGroups[ nGrp ]:bFooter )
next
endif
::Skip( 1 )
nDataRows++
if bProgress != nil .and. nDataRows % 100 == 0
Eval( bProgress, nDataRows, Self )
SysRefresh()
endif
enddo
if lGroup
nLastRow := nRow - 1
// end all groups
for nGrp := nGroups to 1 step -1
WITH OBJECT ( oRng := oSheet:Range( oRange:Cells( nRow, 1 ), oRange:Cells( nRow, nMergeCols ) ) )
:MergeCells := .t.
:Value := aGrpFtr[ nGrp ]
if nGrp > 1
:InsertIndent( nGrp - 1 )
endif
END
nFont := Eval( ::aGroups[ nGrp ]:bFootFont )
if nFont != aFont[ 1 ]
::xlSetFont( oRng, ::aFont[ nFont ] )
endif
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
if oCol:lTotal
cAdr := oSheet:Range( oSheet:Cells( aGrpRow[ nGrp ], nCol ), ;
oSheet:Cells( nLastRow, nCol ) ):Address( .f., .f. )
oSheet:Cells( nRow, nCol ):Formula := "=SUBTOTALES(9;" + cAdr + ")"
nFont := Eval( oCol:bTotalFont )
if nFont != aFont[ nCol ]
::xlSetFont( oSheet:Cells( nRow, nCol ), ::aFont[ nFont ] )
endif
endif
next nCol
nRow++
next nGrp
endif // if lGroup
if lTotal
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
if oCol:lTotal
WITH OBJECT oSheet:Cells( nRow, nCol )
:Formula := "=SUBTOTALES( 9; " + ;
oSheet:Range( oSheet:Cells( nFirstRow, nCol ), ;
oSheet:Cells( nRow - 1, nCol ) ):Address( .f., .f. ) + ")"
END
if ( nFont := Eval( oCol:bTotalFont ) ) != aFont[ nCol ]
::xlSetFont( oSheet:Cells( nRow, nCol ), ::aFont[ nFont ] )
endif
endif
next
endif
WITH OBJECT oRange:Rows( nRow )
if lTotal
WITH OBJECT :Borders( xlTop )
:LineStyle := xlContinuous // 1
:Weight := xlThin
END
endif
WITH OBJECT :Borders( xlBottom )
:LineStyle := xlContinuous // 1
:Weight := xlMedium
END
END
for nCol := 1 to nCols
oCol := ::aColumns[ nCol ]
if !( oCol:lMemo .or. oCol:lImage )
oSheet:Columns( nCol ):AutoFit()
endif
next
cAdr := oSheet:Range( oRange:Rows( nFirstRow ), oRange:Rows( nRow ) ):Address()
oSheet:PageSetUp:PrintArea := cAdr
// Write Title
for nLine := 1 to Len( ::oTitle:aLine )
WITH OBJECT oRange:Rows( nLine )
:MergeCells := .t.
:Value := Eval( ::oTitle:aLine[ nLine ] )
:HorizontalAlignment := { xlLeft, xlRight, xlCenter }[ ::oTitle:aPad[ nLine ] ]
END
::xlSetFont( oRange:Rows( nLine ), ::aFont[ Eval( ::oTitle:aFont[ nLine ] ) ] )
next
oExcel:Visible := .t.
return nil
//----------------------------------------------------------------------------//
METHOD xlSetFont( oRange, oFont ) CLASS TReport
WITH OBJECT oRange:Font
:Name := oFont:cFaceName
:Size := oFont:nHeight * 72 / ::nLogPixY
:Bold := oFont:lBold
:Italic := oFont:lItalic
if oFont:lUnderLine
:UnderLine := xlUnderlineStyleSingle
endif
END
return nil
//----------------------------------------------------------------------------//
METHOD xlHeader( oSetUp ) CLASS TReport
local nLines := Len( ::oHeader:aLine )
local nLine, cText
local aText := { '', '', '' }
if nLines == 1 .and. Empty( Eval( ::oHeader:aLine[ 1 ] ) )
return Self
endif
for nLine := 1 to nLines
aText[ ::oHeader:aPad[ nLine ] ] += xlHeaderLine( ::oHeader:aLine[ nLine ], ;
::aFont[ Eval( ::oHeader:aFont[ nLine ] ) ], ::nLogPixY )
next
AEval( aText, { |c,i| aText[ i ] := SubStr( c, 2 ) } )
WITH OBJECT oSetUp
:LeftHeader := aText[ RPT_LEFT ]
:RightHeader := aText[ RPT_RIGHT ]
:CenterHeader := aText[ RPT_CENTER ]
END
return Self
//----------------------------------------------------------------------------//
METHOD xlFooter( oSetUp ) CLASS TReport
local nLines := Len( ::oFooter:aLine )
local nLine, cText
local aText := { '', '', '' }
if nLines == 1 .and. Empty( Eval( ::oFooter:aLine[ 1 ] ) )
return Self
endif
for nLine := 1 to nLines
aText[ ::oFooter:aPad[ nLine ] ] += xlHeaderLine( ::oFooter:aLine[ nLine ], ;
::aFont[ Eval( ::oFooter:aFont[ nLine ] ) ], ::nLogPixY )
next
AEval( aText, { |c,i| aText[ i ] := SubStr( c, 2 ) } )
WITH OBJECT oSetUp
:LeftFooter := aText[ RPT_LEFT ]
:RightFooter := aText[ RPT_RIGHT ]
:CenterFooter := aText[ RPT_CENTER ]
END
return Self
//----------------------------------------------------------------------------//
static function xlHeaderLine( bHeader, oFont, nLogPixY )
local cStr := ''
local cText := Eval( bHeader )
if ! Empty( cText )
cText := cValToChar( cText )
cStr := ""
if oFont:lBold
cStr := "Bold"
endif
if oFont:lItalic
cStr += " Italic"
endif
if Empty( cStr := LTrim( cstr ) )
cStr := "Normal"
endif
cStr := Chr( 10 ) + '&"' + oFont:cFaceName + ',' + cStr + '"&'
cStr += LTrim( Str( Int( oFont:nHeight * 72 / nLogPixY ) ) )
cStr += cText
endif
return cStr
//----------------------------------------------------------------------------//
