FUNCTION rep_excel(lcursor AS STRING, lnombre AS STRING)
*!* Parametros:
*!* lcursor: Nombre del Cursor o Tabla que se va a llevar a excel
*!* lnombre: El titulo de la pagina
************************************
*!* Program:Rep_excel
*!* Description: Esta función lleva a una hoja excel el contenido de un cursor
*!* Colocando un Nombre pasado como parametro y los nombres de los campos del cursor como encabezado
*!* Revision Information:1.0
*!* Ejemplo de Uso: =rep_excel('mitabla','Listado de Artículos con sus Precios') *!* Enviar Bugs o sugerencias para mejoras a j_samper(sin)@cantv.net
*************************************
IF TYPE('lcursor')#'C' OR !USED(lcursor) =MESSAGEBOX("Parametros Invalidos",16,'De VFP a Excel') RETURN .F.
ENDIF
IF TYPE('lnombre')#'C' lnombre=''
ENDIF
LOCAL lpag AS INTEGER &&&&variable para determinar la página a ingresar los datos por si hay más de 60 mil registros
lpag=1
*** Creación del Objeto Excel
WAIT WINDOW 'Abriendo aplicación Excel.' NOWAIT
Oexcel = CREATEOBJECT("Excel.Application") WAIT CLEAR
IF TYPE('Oexcel')#'O' =MESSAGEBOX("No se puede procesar el archivo porque no tiene la aplicación"+CHR(13)+; "Microsoft Excel instalada en su computador.",16,'De VFP a Excel')
RETURN .F.
ENDIF
WAIT WINDOWS 'Procesando Tabla...'+LOWER(lcursor) NOCLEAR NOWAIT
XLApp = Oexcel
XLApp.workbooks.ADD()
XLSheet = XLApp.ActiveSheet
XLSheet.NAME='VFP_'+ALLTR(STR(lpag))
SELECT(lcursor)
lcuantos=AFIELDS(lcampos,lcursor)
GO TOP IN (lcursor)
LOCAL R,lcampo
R=6
SCAN
IF R= 65500
FOR I = 1 TO lcuantos
lcname=lcampos(I,1)
XLSheet.Cells(4,I).VALUE=lcname
XLSheet.Cells(4,I).FONT.NAME = "Arial"
XLSheet.Cells(4,I).FONT.SIZE = 10
XLSheet.Cells(4,I).FONT.bold = .T.
NEXT
XLSheet.COLUMNS.AUTOFIT
XLSheet.Cells(2,1).VALUE=lnombre
XLSheet.Cells(2,1).FONT.bold = .T.
XLSheet.Cells(1,1).VALUE='Demostración de Vfp a Excel'
XLSheet.Cells(1,1).FONT.bold = .T.
XLSheet.Cells(1,IIF((lcuantos-1)>0,lcuantos-1,lcuantos)).VALUE=ALLTRIM(DTOC(DATE()))
XLSheet.COLUMNS.AUTOFIT
R=6
lpag=lpag+1
XLApp.Sheets(lpag).SELECT
XLSheet = XLApp.ActiveSheet
XLSheet.NAME='VFP_'+ALLTR(STR(lpag))
ENDIF
FOR I=1 TO lcuantos
lcampo=ALLTRIM(lcursor)+'.'+lcampos(I,1)
IF TYPE('&lcampo')#'G' IF TYPE('&lcampo')='C' XLSheet.Cells(R,I).VALUE=ALLTRIM(&lcampo)
XLSheet.Cells(R,I).FONT.NAME = "Arial"
XLSheet.Cells(R,I).FONT.SIZE = 10
ELSE
IF TYPE('&lcampo')='T' XLSheet.Cells(R,I).VALUE=TTOC(&lcampo)
ELSE
XLSheet.Cells(R,I).VALUE=&lcampo
ENDIF
XLSheet.Cells(R,I).FONT.NAME = "Arial"
XLSheet.Cells(R,I).FONT.SIZE = 10
ENDIF
ENDIF
NEXT
R=R+1
ENDSCAN
FOR I = 1 TO lcuantos
lcname=lcampos(I,1)
XLSheet.Cells(4,I).VALUE=lcname
XLSheet.Cells(4,I).FONT.NAME = "Arial"
XLSheet.Cells(4,I).FONT.SIZE = 10
XLSheet.Cells(4,I).FONT.bold = .T.
NEXT
XLSheet.COLUMNS.AUTOFIT
XLSheet.Cells(2,1).VALUE=lnombre
XLSheet.Cells(2,1).FONT.bold = .T.
XLSheet.Cells(1,1).VALUE='Demostración de Vfp a Excel'
XLSheet.Cells(1,1).FONT.bold = .T.
XLSheet.Cells(1,IIF((lcuantos-1)>0,lcuantos-1,lcuantos)).VALUE=ALLTRIM(DTOC(DATE()))
XLSheet.COLUMNS.AUTOFIT
WAIT WINDOWS 'Listo....' NOWAIT
Oexcel.VISIBLE=.T.
RETURN .T.
ENDFUNC
