* ============================================================================
* METHOD TSBrowse:ExcelOle() Version 9.0 Nov/30/2009
* Requires TOleAuto class
* Many thanks to Victor Manuel Tomás for the core of this method
* ============================================================================
METHOD ExcelOle( cXlsFile, lActivate, oMeter, cTitle, oFont, lSave, bExtern, aColSel, bPrintRow ) CLASS TSBrowse
Local oExcel, oBook, oSheet, nRow, nCol, uData, nEvery, oRange, cRange, cCell, cLet, nColHead, nVar, ;
bError, cText, oClip, nStart, aRepl, ;
nLine := 1, ;
nCount := 0, ;
nRecNo := ( ::cAlias )->( RecNo() ), ;
nAt := ::nAt, ;
aCol := { 26, 52, 78, 104, 130, 156 }, ;
aLet := { "", "A", "B", "C", "D", "E" }
Default lActivate := Empty( cXlsFile ), ;
cTitle := ""
Default lSave := ! lActivate .and. ! Empty( cXlsFile ), ;
cXlsFile := ""
CursorWait()
If ::lSelector
::aClipBoard := { OClone( ::aColumns[ 1 ] ), 1, "" }
::DelColumn( 1 )
EndIf
cLet := aLet[ AScan( aCol, {|e| Len( If( aColSel != Nil, aColSel, ::aColumns ) ) <= e } ) ]
If ! Empty( cLet )
nCol := AScan( aLet, cLet ) - 1
cLet += Chr( 64 + Len( If( aColSel != Nil, aColSel, ::aColumns ) ) - aCol[ Max( 1, nCol ) ] )
Else
cLet := Chr( 64 + Len( If( aColSel != Nil, aColSel, ::aColumns ) ) )
EndIf
aRepl := {}
::lNoPaint := .F.
If oMeter != Nil
oMeter:nTotal := ( ::nLen + 1 ) * Len( ::aColumns ) + 30
oMeter:Set( 0 )
oMeter:Refresh()
nEvery := Max( 1, Int( oMeter:nTotal * .02 ) ) // refresh ometer every 2 %
EndIf
If ! Empty( cXlsFile )
cXlsFile := AllTrim( StrTran( Upper( cXlsFile ), ".XLS" ) )
EndIf
cTitle := AllTrim( cTitle )
bError := ErrorBlock( { | x | Break( x ) } )
Begin Sequence
oExcel := TOleAuto():New("Excel.Application")
Recover
ErrorBlock( bError )
CursorArrow()
MsgStop( "No Ole.lib searched", "Error" )
Return Nil
End Sequence
ErrorBlock( bError )
If oMeter != Nil
nCount -= 15
oMeter:Set( nCount )
EndIf
oExcel:WorkBooks:Add()
oBook := oExcel:Get( "ActiveWorkBook")
oSheet := oExcel:Get( "ActiveSheet" )
If oMeter != Nil
nCount -= 15
oMeter:Set( nCount )
EndIf
( ::cAlias )->( Eval( ::bGoTop ) )
cText := ""
For nRow := 1 To ::nLen
If nRow == 1
If ! Empty( cTitle )
oSheet:Cells( nLine++, 1 ):Value := AllTrim( cTitle )
oSheet:Range( "A1:" + cLet + "1" ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection )
++nLine
nStart := nLine
Else
nStart := nLine
EndIf
If ! Empty( ::aSuperHead )
For nCol := 1 To Len( ::aSuperHead )
nVar := If( ::lSelector, 1, 0 )
uData := If( ValType( ::aSuperhead[ nCol, 3 ] ) == "B", Eval( ::aSuperhead[ nCol, 3 ] ), ;
::aSuperhead[ nCol, 3 ] )
oSheet:Cells( nLine, ::aSuperHead[ nCol, 1 ] - nVar ):Value := uData
cRange := Chr( 64 + ::aSuperHead[ nCol, 1 ] - nVar ) + LTrim( Str( nLine ) ) + ":" + ;
Chr( 64 + ::aSuperHead[ nCol, 2 ] - nVar ) + LTrim( Str( nLine ) )
oSheet:Range( cRange ):Borders():LineStyle := xlContinuous
oSheet:Range( cRange ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection )
Next
nStart := nLine ++
EndIf
nColHead := 0
For nCol := 1 To Len( ::aColumns )
If aColSel != Nil .and. AScan( aColSel, nCol ) == 0
Loop
EndIf
uData := If( ValType( ::aColumns[ nCol ]:cHeading ) == "B", Eval( ::aColumns[ nCol ]:cHeading ), ;
::aColumns[ nCol ]:cHeading )
If ValType( uData ) != "C"
Loop
EndIf
uData := StrTran( uData, CRLF, Chr( 10 ) )
nColHead ++
oSheet:Cells( nLine, nColHead ):Value := uData
If oMeter != Nil
If nCount % nEvery == 0
oMeter:Set( nCount )
EndIf
nCount ++
EndIf
Next
nStart := ++ nLine
EndIf
If bPrintRow != Nil .and. ! Eval( bPrintRow, nRow )
::Skip( 1 )
Loop
EndIf
For nCol := 1 To Len( ::aColumns )
If aColSel != Nil .and. AScan( aColSel, nCol ) == 0
Loop
EndIf
uData := Eval( ::aColumns[ nCol ]:bData )
If ValType( uData ) == "C" .and. At( CRLF, uData ) > 0
uData := StrTran( uData, CRLF, "&&" ) // Chr( 10 ) )
If AScan( aRepl, nCol ) == 0
AAdd( aRepl, nCol )
EndIf
EndIf
If ::aColumns[ nCol ]:cPicture != Nil
uData := Transform( uData, ::aColumns[ nCol ]:cPicture )
EndIf
uData := If( ValType( uData )=="D", DtoC( uData ), If( ValType( uData )=="N", Str( uData ) , ;
If( ValType( uData )=="L", If( uData ,".T." ,".F." ), cValToChar( uData ) ) ) )
cText += Trim( uData ) + Chr( 9 )
If oMeter != Nil
If nCount % nEvery == 0
oMeter:Set( nCount )
EndIf
nCount ++
EndIf
Next
::Skip( 1 )
cText += Chr( 13 )
++nLine
/*
Cada 20k volcamos el texto a la hoja de Excel , usando el portapapeles , algo muy rapido y facil ;-)
Every 20k set text into excel sheet , using Clipboard , very easy and faster.
*/
IF Len( cText ) > 20000
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
cCell := "A" + Alltrim( Str( nStart ) )
oRange := oSheet:Range( cCell )
oRange:Select()
oSheet:Paste()
oClip:End()
cText := ""
nStart := nLine + 1
EndIf
Next
If AScan( ::aColumns, { |o| o:cFooting != Nil } ) > 0
For nCol := 1 To Len( ::aColumns )
If ( aColSel != Nil .and. AScan( aColSel, nCol ) == 0 ) .or. ::aColumns[ nCol ]:cFooting == Nil
Loop
EndIf
uData := If( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting ), ;
::aColumns[ nCol ]:cFooting )
uData := cValTochar( uData )
uData := StrTran( uData, CRLF, Chr( 10 ) )
oSheet:Cells( nLine, nCol ):Value := uData
Next
EndIf
If ::lIsDbf
( ::cAlias )->( DbGoTo( nRecNo ) )
EndIf
::nAt := nAt
If Len( cText ) > 0
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
cCell := "A" + Alltrim( Str( nStart ) )
oRange := oSheet:Range( cCell )
oRange:Select()
oSheet:Paste()
oClip:End()
cText := ""
EndIf
nLine := If( ! Empty( cTitle ), 3, 1 )
nLIne += If( ! Empty( ::aSuperHead ), 1, 0 )
cRange := "A" + LTrim( Str( nLine ) ) + ":" + cLet + Alltrim( Str( oSheet:UsedRange:Rows:Count() ) )
oRange := oSheet:Range( cRange )
If oFont != Nil // let the programmer to decide the font he wants, otherwise use Excel's default
oRange:Font:Name := oFont:cFaceName
oRange:Font:Size := oFont:nSize()
oRange:Font:Bold := oFont:lBold
EndIf
If ! Empty( aRepl )
For nCol := 1 To Len( aRepl )
oSheet:Columns( Chr( 64 + aRepl[ nCol ] ) ):Replace( "&&", Chr( 10 ) )
Next
EndIf
If bExtern != Nil
Eval( bExtern, oSheet, Self )
EndIf
oRange:Borders():LineStyle := xlContinuous
oRange:Columns:AutoFit()
If ! Empty( aRepl )
For nCol := 1 To Len( aRepl )
oSheet:Columns( Chr( 64 + aRepl[ nCol ] ) ):WrapText := .T.
Next
EndIf
If oMeter != Nil
oMeter:Set( oMeter:nTotal )
EndIf
If ::lSelector
::InsColumn( ::aClipBoard[ 2 ], ::aClipBoard[ 1 ] )
::lNoPaint := .F.
EndIf
If ! Empty( cXlsFile ) .and. lSave
oBook:SaveAs( cXlsFile, xlWorkbookNormal )
If ! lActivate
CursorArrow()
oExcel:Quit()
::Reset()
Return Nil
EndIf
EndIf
CursorArrow()
If lActivate
oSheet:Range( "A1" ):Select()
oExcel:Visible := .T.
EndIf
::Reset()
Return Nil
