Creacion de archivo Excel .XLSX con mas de 100,000 Lineas

[lubin]

Buen dia amigos del foro y Cesar (SysCtrl2)

Estuve probando tu ejemplo para crear Hojas d calculo extensas en nro de registros y deseaba saber lo siguiente:

Tu Ejemplo abre la Hoja de calculo con los valores transferidos mostrando el resultado, como puedo hacer para que No abra el archivo y lo deje grabado con el nombre "C:\hojasfwh\caja.xls", Yo utilizo harbour para mis programas

Hay algun otro metodo o ejemplo adicional a los mostrados con mayor cantidad de alternativas.

Gracias

[sysctrl2]

Lubin, aqui esta,

ejemplo modificado utilizando SAVEAS,

Saludos..

Code: Select all | Expand

#include "FiveWin.ch"

Function Main()
   Local oSheet
   local oBook
   local oExcel
   local i
   
   local oWait
   
   local nRow := 4
   local nStart := nRow
   local cMemo := ''   
   local oClip
   local nFormat
   local cFile
   
   WAITON(space(30), @oWait)
   oWait:say(1,1,'Creando el objeto...')
   
   oExcel:=CreateObject( "excel.application" );oExcel:DisplayAlerts=.F.;oBook:=oExcel:Workbooks:Add();oSheet:=oExcel:ActiveSheet 
   nFormat     :=   oBook:Get("FileFormat")   
   
   oSheet:Range( "A1" ):Value ="65 mil REGISTROS";oSheet:Range( "A1:D1" ):HorizontalAlignment := 7
   oSheet:Cells(2,3):Value = Time()
   For I=2 To 65000
      oWait:say(2,1, 'Procesando registro: ' + str(i) + space(10 ))
      //oSheet:Cells(I,2):Value = I-1
      cMemo += ''
      cMemo += chr(9) + str(i-1,10)
      cMemo += CRLF
      nRow++     
      

      if len(cMemo) >= 16000  .or. i = 65000
         oClip := TClipBoard():New()
         oClip:SetText( cMemo )
         oSheet:Cells( nStart, 1 ):Select()
         oSheet:Paste()
         oClip:Clear()
         cMemo       := ""
         nStart   := nRow            
         oClip:End()
      endif               
      
      
      sysrefresh()
   Next I
   oSheet:Cells(I-1,3):Value = Time()
   
   
   
   // oExcel:Visible = .T. 
   
   cFile := 'c:\temp\prueba.xls'
   
   oWait:Say(3,1, 'Save Wait')
   
   oBook:saveAS( cFile, nFormat )
   
   ? 'cerrar el obj...'
   
   oExcel:Quit()      

 
   
   waitoff(@oWait)
Return Nil

static function waitOn( cCaption, oWait, cTitle )  //simula un waiton de grump
   LOCAL nWidth
   local lVal := .t.
   local oBrush

   LOCAL   bAction  := { || .t. }
   default cTitle := "Usuario, un momento por favor"
   DEFINE BRUSH oBrush COLOR RGB( 192, 216, 255 )   //rosa


   IF cCaption == NIL
      DEFINE DIALOG oWait ;
         FROM 0,0 TO 12, Len( cTitle ) + 4 ;
         STYLE nOr( DS_MODALFRAME, WS_POPUP ) BRUSH oBrush TRANSPARENT
   ELSE
      DEFINE DIALOG oWait ;
         FROM 0,0 TO 12, Max( Len( cCaption ), Len( cTitle ) ) + 4 ;
         TITLE cTitle ;
         STYLE DS_MODALFRAME BRUSH oBrush TRANSPARENT
   ENDIF

   oWait:cMsg   := cCaption

   nWidth := oWait:nRight - oWait:nLeft

   ACTIVATE DIALOG oWait CENTER ;
      ON PAINT oWait:Say( 1, 0, xPadC( oWait:cMsg, nWidth ) ) ;
      NOWAIT
   sysRefresh()
return (lVal)

static function WaitOff( oWait )
   IF valtype(oWait) <> 'U'  /* waiton has to be called first! */
      oWait:end()
      oWait := NIL
   ENDIF
   sysRefresh()
RETURN NIL
 

[lubin]

Gracias Cesar por el Dato,

Sera posible saber algo mas de la documentacion de las variables y parametros posibles que se pueden usar por ejemplo :

oSheet:Range( "A1:D1" ):HorizontalAlignment := 7 && que valores puede tener este alineamiento , para ese rango de celdas ??
oSheet:Cells(2,3):Value = Time() && Es asignar el valor a la celda (2,3)
oSheet:Cells( nStart, 1 ):Select() && Es seleccionar la Celda de posision (nStart, 1) ???

seria bastante interesante o quizas de donde podemos sacar esa informacion ...

Gracias por todo
Lubin

[sysctrl2]

Hola Lubin,

puedes asignar valores a las celdas de la forma como lo indica el ejemplo anterior,

en lo personal, los titulos de mis reportes lo asigno de la sig. forma.

Code: Select all | Expand

nRow := 3
oSheet:Cells( nRow, 1 ):Value = 'Titulo1 '
oSheet:Cells( nRow, 2 ):Value = 'Titulo2'   
oSheet:Cells( nRow, 3 ):Value = 'Titulo3'  

y en cuanto a la domentacion sobre excel, lo puedes encontrar en este maravilloso foro de fw.

en lo personal muchas cosas lo he sa cado de san google, VB y Excel,

es dependiendo de lo que quieras hacer.

te pongo un ejemplo en el cual uso algunas cosillas como por ejemplo, poner los titulos en negrita,

poner los titulos de un determinado color,

etc.

saludos.

Code: Select all | Expand

METHOD Excel() CLASS InformeReclutas
   local oRange
   local cFile := "\"+CurDir()+'\bmps\logo1.jpg'
   local oClip
   local cText := ''
   local nPasteRow   
   local cPic := '9,999,999.99'
   local i := 1
   local nReclutador, cPv
   local oWait
   
   waiton(space(40), @oWait )
   
   ::nRow := 1
   
   ::oExcel := CREATEOBJECT( "Excel.Application" )
   ::oBook  := ::oExcel:WorkBooks:Add()
   
   
   ::oSheet := ::oBook:Worksheets(1)
   ::oSheet:name:='RECLUTAMIENTO' 
   
   ::oExcel:Sheets( 'RECLUTAMIENTO'  ):Select() 
   ::oSheet := ::oExcel:Get( "ActiveSheet" )      
   
   ::oExcel:Visible = .T.
   
   oRange := ::oSheet:Range("A1")
   
   ::oSheet:Shapes:AddPicture(cFile,.F., .T., oRange:Left, oRange:Top, 170, 70)       
   
   
   ::oSheet:Cells( ::nRow, 6 ):Value = ( ::cStatus )->cia
   ::nRow ++   
   
   ::oSheet:Cells( ::nRow, 6 ):Value = 'RECLUTAMIENTO'
   ::nRow ++
   ::oSheet:Cells( ::nRow, 6 ):Value = 'de semana: ' + strzero( ::nIni,2 ) +'/' + str(::nYear,4) +;
                                   ' a semana: ' + strzero( ::nFin,2 ) +'/' + str(::nYear,4)
   ::nRow +=3
   
   ::oSheet:Cells( ::nRow, 1 ):Value = 'CONS'   
   ::oSheet:Cells( ::nRow, 2 ):Value = 'P.V.'   
   ::oSheet:Cells( ::nRow, 3 ):Value = 'GRUPO'   
   ::oSheet:Cells( ::nRow, 4 ):Value = 'UNIDAD'      
   ::oSheet:Cells( ::nRow, 5 ):Value = 'CLAVE'      
   ::oSheet:Cells( ::nRow, 6 ):Value = 'NOMBRE RECLUTADORA'      
   ::oSheet:Cells( ::nRow, 7 ):Value = 'CLAVE'      
   ::oSheet:Cells( ::nRow, 8 ):Value = 'NOMBRE RECLUTADORA'         
   ::oSheet:Cells( ::nRow, 9 ):Value = 'STATUS'         
   ::oSheet:Cells( ::nRow, 10 ):Value = 'SEM_ING'         
   ::oSheet:Cells( ::nRow, 11 ):Value = 'TOTAL'         
   ::oSheet:Cells( ::nRow, 12 ):Value = 'PEDIDO'         
   ::nRow++
   
   
   nPasteRow := ::nRow
   
   oClip := TClipBoard():New()      
   
   DbSelectArea( ::cReclutas )
   ordsetfocus( 3 )
   set filter to field->grupo >= ::nGpo1 .and. field->grupo <= ::nGpo2 ;
   .and. field->sem_ini >= ::nIni .and. field->sem_fin <= ::nFin ;
   .and. field->anio = ::nYear
   dbgotop()
   while !eof()
      if field->grupo >= ::nGpo1 .and. field->grupo <= ::nGpo2 ;
         .and. field->sem_ini >= ::nIni .and. field->sem_fin <= ::nFin ;
         .and. field->anio = ::nYear
         oWait:say(1,1, cstr(i) + space(10) )
         
         nReclutador := field->reclutador
         cPv := ''
         dbselectArea( ::cClientes )
         ordsetfocus( 11 )
         dbseek( strzero(nReclutador,10)  )           
         if val( field->clave ) = 1
            cPv := '*'
         endif
         
         DbSelectArea( ::cReclutas )
         
         cText += cstr( i )
         cText += chr(9) + cPv
         cText += chr(9) + cstr(field->grupo)
         cText += chr(9) + field->unidad
         cText += chr(9) + cstr(field->reclutador)
         cText += chr(9) + field->nom_rec
         cText += chr(9) + cstr(field->alterno)
         cText += chr(9) + field->nombre
         cText += chr(9) + alltrim( field->status )
         cText += chr(9) + cstr(field->sem_ing)
         cText += chr(9) + iif( field->total > 0, cstr(field->total), ''  ) 
         cText += chr(9) + cstr(field->pedido)
         
         cText += CRLF
         
         if field->total > 0 .and. !empty(cText)
            for x := 1 to 12
               ::oSheet:Cells( ::nRow,11 ):Font:Bold   := .T.
               if field->total > 1
                  ::oSheet:Cells( ::nRow,x ):Interior:Color :=  nRGB( 255,204, 255 )
               endif
            next
         endif
         
         ::nRow++               
         
         if Len( cText ) > 16000
            oClip:SetText( cText )
            ::oSheet:Cells( nPasteRow, 1 ):Select()
            ::oSheet:Paste()
            oClip:Clear()
            cText       := ""
            nPasteRow   := ::nRow
         endif                          
         i ++
         
      endif
      
      sysrefresh()
      DbSelectArea( ::cReclutas )
      dbskip()
      
      
   end
   
   if ! Empty( cText )
      oClip:SetText( cText )
      ::oSheet:Cells( nPasteRow, 1 ):Select()
      ::oSheet:Paste()
      oClip:Clear()
      cText    := ""
   endif         
   
   waitoff(@oWait)
   
   DbSelectArea( ::cReclutas )
   set filter to
   
   
   oClip:Close()   
   oClip:End()   
   
   
   for nFor := 1 to 6
     ::oSheet:Rows( nFor ):Font:Bold   := .T.
   next
  
  for nFor := 1 to 6
     ::oSheet:Cells( 6, nFor ):Interior:Color :=  nRGB( 255,204, 0 )
  next
  
  for nFor := 7 to 12
     ::oSheet:Cells( 6, nFor ):Interior:Color :=  nRGB( 255,255, 0 )
  next  
  
  ::oExcel:Range( "7:7" ):Select() //despues de los titulos hace un freeze
  
  ::oExcel:Application:ActiveWindow:FreezePanes := .T.
  
  ::oSheet:Columns( "A:L" ):AutoFit()            
   
RETURN NIL

[lubin]

He tomado nota de los comentarios y ejemplo , ya les contare como lo aplique

Por otro lado navegando por el foro vi una nota de problemas con el Paste(), no se si afecta a este problema al metodo que estoy usando, que opinas??

Aqui te dejo el hilo de esa nota : viewtopic.php?f=6&t=10747

Gracias Cesar..


Lubin

[sysctrl2]

Lubin, yo uso CREATEOBJECT( "Excel.Application" ) con xharbour,

sin problemas,

funciona con excel, 2003, 2007, 2010, etc.

saludos..