Vfp 6 para excel
HOLA, tengo 2 inquietudes, 1.-¿Quisiera saber como puedo llevar mi base de datos de VFP 6 a execel?, ¿Solo qué me dicen que el 6 no puede hacer eso sino que el 9 es el que elo ase eso es cierto?
1 respuesta
Respuesta de tigrefox
1
1
tigrefox, Colaborador, Solidario y Amigo, Ingeniero de Sistemas,...
La verdad no he probado con vfp6, desde 7 en adelante, de todas formas te voy a enviar un código para que lo pruebes en Vfp6 y me avisas-
Espero poder colaborarte
Pon la Función rep_excel en las librería y lo llamas así:
select CAMPOS from ARCHIVOS where CONDICIONES into cursor RTA
rep_excel("RTA","NOMBRE1"."NOMBRE2"."NOMBRE3")
Mira el resultado y determina que es cada parámetro, el primero si es el nombre del cursor de la consulta
*********************************************************************************************************
FUNCTION rep_excel(lcursor AS STRING, lnombre AS STRING, lDescripcion AS STRING, LDescripcion1 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
*!* Author: José G. Samper
*!* Date: 10/09/03 04:08:04 PM
*!* Copyright: NetBuzo's
*!* Description: Esta función lleva a una hoja excel el contenido de un cursor
*! * Colocando un Nombre pasado como parámetro 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
*************************************
LOCAL R, lcampo, lpag, lReg AS INTEGER &&&&variable para determinar la página a ingresar los datos por si hay más de 60 mil registros
IF TYPE('lcursor')#'C' OR !USED(lcursor)
=MESSAGEBOX("Parametros Invalidos",16,'De VFP a Excel')
RETURN .F.
ENDIF
IF TYPE('lnombre')#'C'
lnombre=''
ENDIF
lpag=1
*** Creación del Objeto Excel
WAIT WINDOW 'Abriendo aplicación Excel.' NOWAIT
Oexcel = CREATEOBJECT("Excel.Application")
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) nowait
XLApp = Oexcel
XLApp.workbooks.ADD()
XLSheet = XLApp.ActiveSheet
XLSheet.NAME = lnombre + "_" + ALLTR(STR(lpag))
SELECT(lcursor)
lcuantos=AFIELDS(lcampos,lcursor)
lReg = ReCcount()
GO TOP IN (lcursor)
R=6
SCAN
WAIT WINDOWS STR(RECNO()*100/lReg,5,2) + '% Procesado de la Información' NOCLEAR NOWAIT
IF R = 65500
FOR I = 1 TO lcuantos
lcname=lcampos(I,1)
XLSheet.Cells(5,I).VALUE=lcname
XLSheet.Cells(5,I).FONT.NAME = "Arial"
XLSheet.Cells(5,I).FONT.SIZE = 10
XLSheet.Cells(5,I).FONT.bold = .T.
NEXT
XLSheet.COLUMNS.AUTOFIT
XLSheet.Cells(1,1).VALUE= UPPER(lDescripcion)
XLSheet.Cells(1,1).FONT.bold = .T.
XLSheet.Cells(2,1).VALUE = FtoL(S_Fecsis)
XLSheet.Cells(2,1).FONT.bold = .T.
XLSheet.Cells(3,1).VALUE= lDescripcion1
XLSheet.COLUMNS.AUTOFIT
R=6
lpag=lpag+1
XLApp.Sheets(lpag).SELECT
XLSheet = XLApp.ActiveSheet
XLSheet.NAME=lnombre+"_"+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
IF TYPE('&lcampo')='D'
XLSheet.Cells(R,I).VALUE=DTOC(&lcampo)
else
XLSheet.Cells(R,I).VALUE= &lcampo
endif
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(5,I).VALUE=lcname
XLSheet.Cells(5,I).FONT.NAME = "Arial"
XLSheet.Cells(5,I).FONT.SIZE = 10
XLSheet.Cells(5,I).FONT.bold = .T.
NEXT
XLSheet.COLUMNS.AUTOFIT
XLSheet.Cells(1,1).VALUE= UPPER(lDescripcion)
XLSheet.Cells(1,1).FONT.bold = .T.
*XLSheet.Cells(1,IIF((lcuantos-1)>0,lcuantos-1,lcuantos)).VALUE=ALLTRIM(DTOC(DATE()))
XLSheet.Cells(2,1).VALUE=FtoL(S_Fecsis)
XLSheet.Cells(2,1).FONT.bold = .T.
XLSheet.Cells(3,1).VALUE = lDescripcion1
XLSheet.COLUMNS.AUTOFIT
WAIT WINDOWS 'Listo....' NOWAIT
Oexcel.VISIBLE=.T.
RETURN .T.
Endfunc
Espero poder colaborarte
Pon la Función rep_excel en las librería y lo llamas así:
select CAMPOS from ARCHIVOS where CONDICIONES into cursor RTA
rep_excel("RTA","NOMBRE1"."NOMBRE2"."NOMBRE3")
Mira el resultado y determina que es cada parámetro, el primero si es el nombre del cursor de la consulta
*********************************************************************************************************
FUNCTION rep_excel(lcursor AS STRING, lnombre AS STRING, lDescripcion AS STRING, LDescripcion1 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
*!* Author: José G. Samper
*!* Date: 10/09/03 04:08:04 PM
*!* Copyright: NetBuzo's
*!* Description: Esta función lleva a una hoja excel el contenido de un cursor
*! * Colocando un Nombre pasado como parámetro 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
*************************************
LOCAL R, lcampo, lpag, lReg AS INTEGER &&&&variable para determinar la página a ingresar los datos por si hay más de 60 mil registros
IF TYPE('lcursor')#'C' OR !USED(lcursor)
=MESSAGEBOX("Parametros Invalidos",16,'De VFP a Excel')
RETURN .F.
ENDIF
IF TYPE('lnombre')#'C'
lnombre=''
ENDIF
lpag=1
*** Creación del Objeto Excel
WAIT WINDOW 'Abriendo aplicación Excel.' NOWAIT
Oexcel = CREATEOBJECT("Excel.Application")
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) nowait
XLApp = Oexcel
XLApp.workbooks.ADD()
XLSheet = XLApp.ActiveSheet
XLSheet.NAME = lnombre + "_" + ALLTR(STR(lpag))
SELECT(lcursor)
lcuantos=AFIELDS(lcampos,lcursor)
lReg = ReCcount()
GO TOP IN (lcursor)
R=6
SCAN
WAIT WINDOWS STR(RECNO()*100/lReg,5,2) + '% Procesado de la Información' NOCLEAR NOWAIT
IF R = 65500
FOR I = 1 TO lcuantos
lcname=lcampos(I,1)
XLSheet.Cells(5,I).VALUE=lcname
XLSheet.Cells(5,I).FONT.NAME = "Arial"
XLSheet.Cells(5,I).FONT.SIZE = 10
XLSheet.Cells(5,I).FONT.bold = .T.
NEXT
XLSheet.COLUMNS.AUTOFIT
XLSheet.Cells(1,1).VALUE= UPPER(lDescripcion)
XLSheet.Cells(1,1).FONT.bold = .T.
XLSheet.Cells(2,1).VALUE = FtoL(S_Fecsis)
XLSheet.Cells(2,1).FONT.bold = .T.
XLSheet.Cells(3,1).VALUE= lDescripcion1
XLSheet.COLUMNS.AUTOFIT
R=6
lpag=lpag+1
XLApp.Sheets(lpag).SELECT
XLSheet = XLApp.ActiveSheet
XLSheet.NAME=lnombre+"_"+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
IF TYPE('&lcampo')='D'
XLSheet.Cells(R,I).VALUE=DTOC(&lcampo)
else
XLSheet.Cells(R,I).VALUE= &lcampo
endif
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(5,I).VALUE=lcname
XLSheet.Cells(5,I).FONT.NAME = "Arial"
XLSheet.Cells(5,I).FONT.SIZE = 10
XLSheet.Cells(5,I).FONT.bold = .T.
NEXT
XLSheet.COLUMNS.AUTOFIT
XLSheet.Cells(1,1).VALUE= UPPER(lDescripcion)
XLSheet.Cells(1,1).FONT.bold = .T.
*XLSheet.Cells(1,IIF((lcuantos-1)>0,lcuantos-1,lcuantos)).VALUE=ALLTRIM(DTOC(DATE()))
XLSheet.Cells(2,1).VALUE=FtoL(S_Fecsis)
XLSheet.Cells(2,1).FONT.bold = .T.
XLSheet.Cells(3,1).VALUE = lDescripcion1
XLSheet.COLUMNS.AUTOFIT
WAIT WINDOWS 'Listo....' NOWAIT
Oexcel.VISIBLE=.T.
RETURN .T.
Endfunc
HOLA, tengo 2 inquietudes, 1.-¿Quisiera saber como puedo llevar mi base de datos de VFP 6 a execel?, ¿Solo qué me dicen que el 6 no puede hacer eso sino que el 9 es el que elo ase eso es cierto?
Copia datos de una base de datos a un archivo
COPY TO archivo DATABASE datos NAME t02_invcontcs FIELDS t02contratista, t02codigo TYPE sdf
esta instrucción crea un archivo plano con información extraída de t02_invcontcs de la base de datos DATOS, ahora bien si lo que necesita es crear otra tabla archivo.dbf quite el TYPE SDF
COPY TO archivo DATABASE datos NAME t02_invcontcs FIELDS t02contratista, t02codigo TYPE sdf
esta instrucción crea un archivo plano con información extraída de t02_invcontcs de la base de datos DATOS, ahora bien si lo que necesita es crear otra tabla archivo.dbf quite el TYPE SDF
- Compartir respuesta
- Anónimo
ahora mismo