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

Post Reply
User avatar
lafug
Posts: 185
Joined: Thu Nov 17, 2005 12:48 am
Location: Santiago, Chile

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

Post 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 :D
Luis Alfonso Fuentes Guerrero
FWH 11.06 xHarbour 1.2.1 BCC55 WorkShop
Top
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:
Contact Antonio Linares

Post 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.
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
User avatar
Vikthor
Posts: 271
Joined: Fri Oct 07, 2005 5:20 am
Location: México

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

Post 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
Vikthor
Top
User avatar
lafug
Posts: 185
Joined: Thu Nov 17, 2005 12:48 am
Location: Santiago, Chile

Post 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
Luis Alfonso Fuentes Guerrero
FWH 11.06 xHarbour 1.2.1 BCC55 WorkShop
Top
User avatar
Vikthor
Posts: 271
Joined: Fri Oct 07, 2005 5:20 am
Location: México

Post 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()
Vikthor
Top
User avatar
lafug
Posts: 185
Joined: Thu Nov 17, 2005 12:48 am
Location: Santiago, Chile

Post 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
Luis Alfonso Fuentes Guerrero
FWH 11.06 xHarbour 1.2.1 BCC55 WorkShop
Top
User avatar
lafug
Posts: 185
Joined: Thu Nov 17, 2005 12:48 am
Location: Santiago, Chile

Post by lafug »

la clase TSbrowse, que me envias, que debo hacer y donde
Luis Alfonso Fuentes Guerrero
FWH 11.06 xHarbour 1.2.1 BCC55 WorkShop
Top
User avatar
Vikthor
Posts: 271
Joined: Fri Oct 07, 2005 5:20 am
Location: México

Post by Vikthor »

Sustituye oSheet:Range( cCell )

Por oExcel:oSheet:Range( cCell )

y revisa que lo demás objetos que se crean tengan referencia.
Vikthor
Top
User avatar
lafug
Posts: 185
Joined: Thu Nov 17, 2005 12:48 am
Location: Santiago, Chile

Post 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
Luis Alfonso Fuentes Guerrero
FWH 11.06 xHarbour 1.2.1 BCC55 WorkShop
Top
User avatar
Vikthor
Posts: 271
Joined: Fri Oct 07, 2005 5:20 am
Location: México

Post 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.
Vikthor
Top
User avatar
lafug
Posts: 185
Joined: Thu Nov 17, 2005 12:48 am
Location: Santiago, Chile

Post 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
Luis Alfonso Fuentes Guerrero
FWH 11.06 xHarbour 1.2.1 BCC55 WorkShop
Top
Post Reply

Return to “FiveWin para Harbour/xHarbour”