Vikthor: El ejemplo funcionó bien (TEXCELS) ..pero

[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

[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.

[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  Expand view

* ============================================================================
* 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


[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

[Vikthor]

Esta pequeña modificación te debe de funcionar.

Code: Select all  Expand view


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()



[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

[lafug]

la clase TSbrowse, que me envias, que debo hacer y donde

[Vikthor]

Sustituye oSheet:Range( cCell )

Por oExcel:oSheet:Range( cCell )

y revisa que lo demás objetos que se crean tengan referencia.

[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

[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.

[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