Page 1 of 1
Vikthor: El ejemplo funcionó bien (TEXCELS) ..pero
Posted: Tue Jan 10, 2006 2:46 am
by lafug
Estimado Vikthor
el ejemplo funciona , pero me imagino que la variable cText no da la capacidad suficiente para mas de 600 registros
el ejemplo lo apliqué así:
cText:=""
cText:="LISTADO DE ALIMENTOS"+CHR(13)
cText+=Chr(13)
MSGWAIT("GENERANDO")
DO WHILE NUTRIEN->(!EOF())
cText:=cText+NUTRIEN->Alimento+CHR(9)+;
STR(NUTRIEN->Calorias)+CHR(13)
NUTRIEN->(DBSKIP())
ENDDO
oExcel := TExcelScript():New()
oExcel:Create( 'Temp.xls' )
oExcel:visualizar(.T.)
oClip :=TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
oExcel:SetPos('B5')
nCol:=cLetter2Column( 'B' )
oExcel:Paste()
oClip:End()
cRange:=cMakeRange( 5 , nCol, ( 5+oExcel:nRowsCount() ) - 1 , (nCol+oExcel:nColsCount())-1 )
oRange := oExcel:oSheet:Range(cRange)
oRange:Font:Name := 'Tahoma'
oRange:Font:Size := 10
oRange:Font:Bold := .T.
oRange:Font:Color := rgb(0,0,150)
oRange:Interior:Color := rgb(192,192,192)
oRange:Borders():LineStyle := 1
oRange:Columns:AutoFit()
De que manera puedo mostrar todos los registros en el Exce?
LA TABLA NUTRIEN.DBF TIENE 1600 REGISTROS
DE ANTEMANO MUCHAS GRACIAS POR TU VALIOSA AYUDA
SALUDOS
Posted: Tue Jan 10, 2006 8:32 am
by Antonio Linares
Luis,
Salvo que haya alguna limitación específica en Excel, en 32 bits no tienes limitación para el tamaño de las cadenas. En principio podria llegar a medir hasta 4 gigas.
Re: Vikthor: El ejemplo funcionó bien (TEXCELS) ..pero
Posted: Tue Jan 10, 2006 2:41 pm
by Vikthor
Manejando el portapapeles y Excel he trabajado más de 10mil registros en unos cuantos segundos usando la clase TExcel.
La solución a tu problema es muy sencillo, te anexo el método que modifique a la clase TSbrowse en su versión 7 donde puedes hacer la migración de una tabla completa a Excel sin importar el número de registro que tenga.
Code: Select all
* ============================================================================
* METHOD TSBrowse:ExcelOle() Version 7.0 Jul/15/2004
* Requires TOleAuto class
* Many thanks to Victor Manuel Tomás ( Vikthor ) for the core of this method
* ============================================================================
METHOD ExcelOle( cXlsFile, lActivate, oMeter, cTitle, ;
oFont, lSave ) CLASS TSBrowse
Local oExcel, oBook, oSheet, nRow, nCol, uData, nEvery, oRange, cRange, cCell, ;
bError, cText, oClip, nStart, ;
nLine := 1, ;
nCount := 0, ;
nRecNo := ( ::cAlias )->( RecNo() ), ;
nAt := ::nAt
Default lActivate := Empty( cXlsFile ), ;
cTitle := "", ;
lSave := .F.
CursorWait()
::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
cXlsFile := AllTrim( StrTran( Upper( cXlsFile ), ".XLS" ) )
cTitle := AllTrim( cTitle )
* bError := ErrorBlock( { | x | Break( x ) } )
TRY
oExcel := GetActiveObject( "Excel.Application" )
oWord := GetActiveObject( "Word.Application" )
CATCH
TRY
oExcel := CreateObject( "Excel.Application" )
oWord := CreateObject( "Word.Application" )
CATCH
Alert( "ERROR! Excel no está instaldo en esta PC. " )
END
END
/*
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" )
oDocs := oWord:Get( "Documents")
oDocs:Invoke( "Add" )
oActiveDoc := oWord:Get("ActiveDocument")
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:" + Chr( 64 + Len( ::aColumns ) ) + ;
"1" ):Set( "HorizontalAlignment", 7 )
++nLine
nStart := nLine
Else
nStart := 1
EndIf
For nCol := 1 To Len( ::aColumns )
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 ) )
cText += uData + Chr( 9 )
If oMeter != Nil
If nCount % nEvery == 0
oMeter:Set( nCount )
EndIf
nCount ++
EndIf
Next
cText += Chr( 13 )
EndIf
For nCol := 1 To Len( ::aColumns )
If ::aColumns[ nCol ]:lBitMap
Loop
EndIf
uData := Eval( ::aColumns[ nCol ]:bData )
If ValType( uData ) == "C"
uData := StrTran( uData, CRLF, Chr( 10 ) )
EndIf
If ::aColumns[ nCol ]:cPicture != Nil
uData := Transform( uData, ::aColumns[ nCol ]:cPicture )
EndIf
uData := IIF( ValType( uData )=="D", DtoC( uData ), ;
IIF( ValType( uData )=="N", Str( uData ) , ;
IIF( ValType( uData )=="L", IIF( uData ,".T." ,".F." ), uData ) ) )
cText+=alltrim( 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()
oTexto := oActiveDoc:Range()
oTables := oActiveDoc:Get( "Tables")
nRows:=250
nCols:=40
oTexto:SetRange( 1 , 1 )
oTable:= oTables:Invoke("Add", oTexto , nRows , nCols )
* oTable:Paste()
oClip:End()
cText := ""
nStart := nLine + 1
EndIf
Next
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
cRange := "A3:" + Chr( 64 + Len( ::aColumns ) ) + ;
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
oRange:Borders():LineStyle := 1
oRange:Columns:AutoFit()
If oMeter != Nil
oMeter:Set( oMeter:nTotal )
EndIf
If cXlsFile != Nil .and. lSave
oBook:SaveAs( cXlsFile, -4143 ) // -4143 = Normal
EndIf
oSheet:Range( "A1" ):Select()
CursorArrow()
If lActivate
oExcel:Visible := .T.
oWord:Visible := .T.
EndIf
OleUninitialize()
Return Nil
Posted: Tue Jan 10, 2006 4:21 pm
by lafug
ESTIMADO VIKTHOR :
Creo que tal como tu dices el portapapeles con excel debería funcionar con muchos registros, yo tengo Windows XP y Office 2003 y este es el programa donde tengo el problema:
DO WHILE NUTRIEN->(!EOF())
cText:=cText+NUTRIEN->Alimento+CHR(9)+CHR(13) // +STR(NUTRIEN->Calorias)+CHR(13)
NUTRIEN->(DBSKIP())
ENDDO
oExcel := TExcelScript():New()
oExcel:Create( 'Temp.xls' )
oExcel:visualizar(.T.)
oClip :=TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
oExcel:SetPos('B5')
nCol:=cLetter2Column( 'B' )
oExcel:Paste()
// oClip:End()
cRange:=cMakeRange( 5 , nCol, ( 5+oExcel:nRowsCount() ) - 1 , ( nCol+oExcel:nColsCount())-1 )
oRange := oExcel:oSheet:Range(cRange)
oRange:Font:Name := 'Tahoma'
oRange:Font:Size := 10
oRange:Font:Bold := .T.
oRange:Font:Color := rgb(0,0,150)
oRange:Interior:Color := rgb(192,192,192)
oRange:Borders():LineStyle := 1
oRange:Columns:AutoFit()
Quizás me falta algo ?...
DE ANTEMANO, GRACIAS POR TU AYUDA
Posted: Tue Jan 10, 2006 4:41 pm
by Vikthor
Esta pequeña modificación te debe de funcionar.
Code: Select all
oExcel := TExcelScript():New()
oExcel:Create( 'Temp.xls' )
oExcel:visualizar(.T.)
nLine := 0
DO WHILE NUTRIEN->(!EOF())
cText:=cText+NUTRIEN->Alimento+CHR(9)+CHR(13) // +STR(NUTRIEN->Calorias)+CHR(13)
/*
Cada 20k volcamos el texto a la hoja de Excel , usando el portapapeles , algo muy rapido y facil ;-)
*/
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
nLine++
nStart:=nLine
NUTRIEN->(DBSKIP())
ENDDO
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()
ENDIF
oExcel:SetPos('B5')
nCol:=cLetter2Column( 'B' )
oExcel:Paste()
cRange:=cMakeRange( 5 , nCol, ( 5+oExcel:nRowsCount() ) - 1 , ( nCol+oExcel:nColsCount())-1 )
oRange := oExcel:oSheet:Range(cRange)
oRange:Font:Name := 'Tahoma'
oRange:Font:Size := 10
oRange:Font:Bold := .T.
oRange:Font:Color := rgb(0,0,150)
oRange:Interior:Color := rgb(192,192,192)
oRange:Borders():LineStyle := 1
oRange:Columns:AutoFit()
Posted: Tue Jan 10, 2006 7:24 pm
by lafug
ESTIMADO VIKTHOR :
AL EJECUTAR EL PROGRAMA, ESTE SE ME CAE, NO ME RECONOCE LAS SIGUIENTES OPCIONES
oRange := oSheet:Range( cCell )
oRange:Select()
oSheet:Paste()
ESTAS SON LAS PRIMERAS DE ERROR DEL ARCHIVO LOG
Application
===========
Path and name: C:\sofnut\SOFNUTR.Exe (32 bits)
Size: 1,474,560 bytes
Time from start: 0 hours 0 mins 2 secs
Error occurred at: 10/01/2006, 16:20:00
Error description: Error BASE/1004 Class: 'NUMERIC' has no exported method: RANGE
Args:
[ 1] = C A323
Stack Calls
===========
Called from: => RANGE(0)
Called from: exel.prg => TEST(149)
AL PARECER, FALTA ALGO
Posted: Tue Jan 10, 2006 7:25 pm
by lafug
la clase TSbrowse, que me envias, que debo hacer y donde
Posted: Tue Jan 10, 2006 7:29 pm
by Vikthor
Sustituye oSheet:Range( cCell )
Por oExcel:oSheet:Range( cCell )
y revisa que lo demás objetos que se crean tengan referencia.
Posted: Wed Jan 11, 2006 5:00 pm
by lafug
Vikthor, por las dudas, es posible usar la sintaxis de la texcels que uso con FW Clipper en FW xHarbour y si es asi la clase necesita ser modificada? ya que esta sintaxis es muy práctica y clara para emitir informes en excel desde el prg.
DEFINE XLS FONT nFonTot NAME "Arial" HEIGHT 10 BOLD //letras detalle
DEFINE XLS FORMAT nFormat PICTURE "#,##0"
..ETC
XLS oFileXLS FILE "VENTAS.XLS" AUTOEXEC
XLS COL 2 WIDTH 30 OF oFileXLS
@1,1 XLS SAY "VENTAS ENERO 2006" FONT nFonTot OF oFileXLS
DO WHILE ARCHIVO->(!EOF())
@FILA,1 XLS SAY ARCHIVO->FACTURA FONT nFonDet OF oFileXLS
@ ......ETC
ARCHIVO->(DBSKIP())
ENDDO
XLS PAGE BREAK AT 39 OF oFileXLS
ENDXLS oFileXLS
SHELLEXECUTE(,"OPEN","LISPER.XLS",,,)
GRAcias y saludos
Posted: Wed Jan 11, 2006 5:13 pm
by Vikthor
Creo que estas un poco confundido, el código que muestras en tu post corresponde a la clase TFileXls de Ramón Avendaño
Y el código que te mostré yo corresponde a la clase TExcelScript.
El código de TFileXls es totalmente compatible con xHarbour.
Posted: Wed Jan 11, 2006 5:37 pm
by lafug
GRACIAS VIKTHOR!! por tu aclaración y de donde puedo bajar la clase de Ramon Avendaño?
y también la classe tfolder y los botones con bitmaps de rossine?
SALUDOS Y GRACIAS