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
#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 NILGracias 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
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 := ::WorkBooks:Add()
::oSheet := ::Worksheets(1)
::='RECLUTAMIENTO'
::Sheets( 'RECLUTAMIENTO' ):Select()
::oSheet := ::Get( "ActiveSheet" )
::Visible = .T.
oRange := ::Range("A1")
::AddPicture(cFile,.F., .T., oRange:Left, oRange:Top, 170, 70)
::Cells( ::nRow, 6 ):Value = ( ::cStatus )->cia
::nRow ++
::Cells( ::nRow, 6 ):Value = 'RECLUTAMIENTO'
::nRow ++
::Cells( ::nRow, 6 ):Value = 'de semana: ' + strzero( ::nIni,2 ) +'/' + str(::nYear,4) +;
' a semana: ' + strzero( ::nFin,2 ) +'/' + str(::nYear,4)
::nRow +=3
::Cells( ::nRow, 1 ):Value = 'CONS'
::Cells( ::nRow, 2 ):Value = 'P.V.'
::Cells( ::nRow, 3 ):Value = 'GRUPO'
::Cells( ::nRow, 4 ):Value = 'UNIDAD'
::Cells( ::nRow, 5 ):Value = 'CLAVE'
::Cells( ::nRow, 6 ):Value = 'NOMBRE RECLUTADORA'
::Cells( ::nRow, 7 ):Value = 'CLAVE'
::Cells( ::nRow, 8 ):Value = 'NOMBRE RECLUTADORA'
::Cells( ::nRow, 9 ):Value = 'STATUS'
::Cells( ::nRow, 10 ):Value = 'SEM_ING'
::Cells( ::nRow, 11 ):Value = 'TOTAL'
::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
::Cells( ::nRow,11 ):Bold := .T.
if field->total > 1
::Cells( ::nRow,x ):Color := nRGB( 255,204, 255 )
endif
next
endif
::nRow++
if Len( cText ) > 16000
oClip:SetText( cText )
::Cells( nPasteRow, 1 ):Select()
::Paste()
oClip:Clear()
cText := ""
nPasteRow := ::nRow
endif
i ++
endif
sysrefresh()
DbSelectArea( ::cReclutas )
dbskip()
end
if ! Empty( cText )
oClip:SetText( cText )
::Cells( nPasteRow, 1 ):Select()
::Paste()
oClip:Clear()
cText := ""
endif
waitoff(@oWait)
DbSelectArea( ::cReclutas )
set filter to
oClip:Close()
oClip:End()
for nFor := 1 to 6
::Rows( nFor ):Bold := .T.
next
for nFor := 1 to 6
::Cells( 6, nFor ):Color := nRGB( 255,204, 0 )
next
for nFor := 7 to 12
::Cells( 6, nFor ):Color := nRGB( 255,255, 0 )
next
::Range( "7:7" ):Select() //despues de los titulos hace un freeze
::Application:ActiveWindow:FreezePanes := .T.
::Columns( "A:L" ):AutoFit()
RETURN NILHe 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
Lubin, yo uso CREATEOBJECT( "Excel.Application" ) con xharbour,
sin problemas,
funciona con excel, 2003, 2007, 2010, etc.
saludos..