Ante todo le doy las gracias. Tengo archivos en visual foxpro las cuales son dbf's Las cuales necesito importarlos a excel. Pregunta si me pudiera dar donde puedo obtener un programa que me realice estas importaciones. Gracias.
1 respuesta
Respuesta de tigrefox
1
1
tigrefox, Colaborador, Solidario y Amigo, Ingeniero de Sistemas,...
Lo he usado con vfp7 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