FiveTech Software tech support forums

#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
 

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

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