Se ha escrito mucho acerca de exportar datos a Excel. Pero esta funcion que modifique gracias a rutinas encontradas en este Blog, me ha sacado de apuros.
*-------------------------------------------------------------------------------------
*----------- FUNCTION EXPORTAR A MS EXCEL --------------------------------------------
*-------------------------------------------------------------------------------------
*-- MarcoMolina("27/07/2006")
*-- Genere una instruccion SQL READWRITE partiendo de una Tabla/Cursor
*-- con el formato que se desea.
*-- Limitacion exporta solo 26 campos a MS Excel
*-- USO:
*-- Exportar_Excel("CursorSQL","Encabezado del Reporte",Dsd,Hst,"Nombre de la Empresa",.f.)
* Dsd : Fecha que inicia el rango del reporte, si no se requiere deje ""
* Dsd : Fecha que final del rango del reporte, si no se requiere deje ""
* CursorSQL : Nombre de la Tabla/Cursor
* .t./.f. : Indica que protege la hoja de excel con password
*--Forma de USO:
CLOSE DATABASES
SELECT 0
USE OrigenDatos
SELECT CAST(Camp0 AS N(1)) AS "I",;
Camp1 AS Campo1,;
Camp2 AS Campo2,;
Camp3 AS Campo3;
FROM OrigenDatos;
WHERE BETWEEN(Fecha,Dsd,Hst);
INTO CURSOR CursorSQL READWRITE
*--Instrucciones para dar formato al CursorSQL. Si se requiere.
IF RECCOUNT() > 0
=Exportar_Excel("CursorSQL","Encabezado del Reporte",Dsd,Hst,"Nombre de Empresa",.F.)
ELSE
WAIT WIND "No existen registros para procesar"
ENDIF
FUNCTION Exportar_Excel
PARAMETERS cTabla,cTitulo,cDesde,cHasta,cEmpresa,cproteg
IF VARTYPE(cProteg) = "U"
cProteg = .F. &&la hoja de excel estara protegida=.t. - modificable=.f.
ENDIF
IF TYPE("cDesde") = "L" OR TYPE("cHasta") = "L"
Periodo = ""
ELSE
IF !EMPTY(cDesde) AND !EMPTY(cHasta)
IF TYPE("cDesde") = "D" OR TYPE("cHasta") = "D"
Periodo = "Desde: " + ALLTRIM(DTOC(cDesde)) +" Hasta: "+ ALLTRIM(DTOC(cHasta))
ELSE
Periodo = "Desde: " + ALLTRIM(cDesde) +" Hasta: "+ ALLTRIM(cHasta)
ENDIF
ELSE
Periodo = ""
ENDIF
ENDIF
*--Selecciona la tabla pasada por parametro - Resultado del SQL
SELECT (cTabla)
AreaTabla = SELECT()
COUNT FOR !DELETED() TO Lineas
*--Identificacion de la columna de la hoja Excel
*--ID_Col = Nombres de las columnas A1,B2,C3...
*--AnchoCol = Ancho de la columna
*--TipoCmp = Formato del campo si es Caracter, Numerico, Fecha.
CREATE CURSOR LargoCol (ID_Col C(10),AnchoCol N(8),TipoCmp C(1))
*--Separa los campos de la tabla por comas
*--Identifica la columna en la tabla ...A1,B2,C3,D4.....
*--Solo 26 campos permite identificar de A-Z
SELECT (AreaTabla)
cString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
STORE "" TO cLago,cCh,nCampo
FOR xCta = 1 TO FCOUNT()
*--Lista de campos separados por comas.
nCampo = nCampo + FIELD(xCta) + ","
*--Largo de cada campo
cLago=FSIZE(FIELD(xCta))
*--Tipo de campo
cTipo=TYPE(FIELD(xCta))
*--Establece el ancho de la columna como minimo 13 espacios
IF cLago <= 10
cLago = 13
ENDIF
*--Identifica las columnas A1 B2 C3..
cCh = SUBSTR(cString,xCta,1)
gCh = cCh+ALLTRIM(STR(xCta))
*--Guarda la configuracion del tamñano de los campos y nombre etc.
INSERT INTO LargoCol (AnchoCol,ID_Col,TipoCmp) VALUES (cLago,gCh,cTipo)
*--Reestablece la tabla
SELECT (AreaTabla)
NEXT
SELECT (AreaTabla)
*--Quita la ultima "," de la concatenacion de los nombres de campos del cursor
nCampo = SUBSTR(nCampo,1,LEN(nCampo)-1)
*--Determinar la ultima columna del reporte
SELECT LargoCol
xEnca = LEFT(ALLTRIM(Id_Col),1) + "5"
xHay = LEFT(ALLTRIM(Id_Col),1) + ALLTRIM(STR(Lineas+7))
*--Solo 26 campos son exportables
IF xCta > 26
=MESSAGEBOX("La tabla... &cTabla tiene...(" + ALLTRIM(STR(xCta)) + ") " + ;
"campos, de los cuales solo... (26) pueden ser " + CHR(13)+;
"exportados a MS Excel.",48,Titulo)
CLOSE DATABASES
RETURN
ENDIF
*---------------------------------------------------------
*-- EXPORTA LA TABLA
*---------------------------------------------------------
WAIT WINDOW "Abriendo MS Excel..." NOWAIT
SELECT (AreaTabla)
*-- Nombre y path de la hoja
TxtFilename = FULLPATH("Temps\Exprt_Excel"+Usuario)
EXPORT FIELDS &nCampo TO ALLTRIM((TxtFileName)) TYPE XL5
oExcel = CREATEOBJECT("Excel.Application")
WITH oExcel
.DisplayAlerts = .F.
.Workbooks.OPEN(TxtFilename)
.ActiveWindow.DisplayZeros = "FALSE"
*- Renombra la hoja de calculo
cHoja=RIGHT(TxtFileName,13) &&"Exprt_Excel"+Usuario
.Sheets("&cHoja").SELECT
.Sheets("&cHoja").NAME = "MM-Empresarial"
*--Inserta lineas en blanco para titulos del reporte
.RANGE("A1:A4").SELECT
.SELECTION.EntireRow.INSERT
*--Formatea el ancho de las columnas en la hoja
SELECT LargoCol
SCAN ALL
_Col = ALLTRIM(ID_Col)
_Cls = LEFT(_Col,1)
_Ach = AnchoCol
.COLUMNS("&_Cls:&_Cls").COLUMNWIDTH = _Ach
*--Si la columna es numerica le da el formato
IF ALLTRIM(TipoCmp) = "D"
.RANGE("&_Cls:&_Cls").HorizontalAlignment = -4152
ENDIF
IF ALLTRIM(TipoCmp) = "N"
*--Alinemiento del encabezado de la columna
.RANGE("&_Cls:&_Cls").HorizontalAlignment = -4152
_Fin = "&_Cls"+ALLTRIM(STR(Lineas+50))
.RANGE("A1:&_Fin").SELECT
.SELECTION.NumberFormat = "#,##0.00"
ENDIF
*--Coloca las mayusculas a los encabezados de columna
_Clu = LEFT(ALLTRIM(ID_Col),1)
_DsdA5 = "&_Clu"+"5"
.RANGE("&_DsdA5:&_DsdA5").SELECT
.RANGE("&_DsdA5:&_DsdA5").VALUE = UPPER(.RANGE("&_DsdA5:&_DsdA5").VALUE)
ENDSCAN
*--Inserta nombre de la empresa y titulo del reporte
.RANGE("A1:A1").SELECT
.RANGE("A1:A1").VALUE = UPPER(ALLTRIM(lpEmpresa))
.RANGE("A2:A2").SELECT
.RANGE("A2:A2").VALUE = cTitulo
.RANGE("A3:A3").SELECT
.RANGE("A3:A3").VALUE = Periodo
*--Formato/Presentacion de hoja
.RANGE("A1:&xHay").SELECT
.SELECTION.AutoFormat(1,.T.,.T.,.T.,.T.,.T.,.T.)
*--Color del fondo de encabezado de columnas
.RANGE("A5:&xEnca").SELECT
WITH .SELECTION.Interior
.ColorIndex = 36
.PATTERN = 1
ENDWITH
*--Fuente para la hoja
.RANGE("A6:&xHay").SELECT
WITH .SELECTION.FONT
.NAME = "Arial"
.SIZE = 9
ENDWITH
*--Fuente para el titulo del reporte
.RANGE("A1:A1").SELECT
WITH .SELECTION.FONT
.NAME = "Arial"
.SIZE = 12
ENDWITH
*--Inserta una columna en blanco
.SELECTION.EntireColumn.INSERT
IF xCta > 3
.COLUMNS("A:A").COLUMNWIDTH = 8
ELSE
.COLUMNS("A:A").COLUMNWIDTH = 3
ENDIF
*---Protege la hoja con password
IF cProteg
*--Proteje la hoja
.ActiveSheet.PROTECT("MaMh,.t.,.t.")
ENDIF
.VISIBLE = .T.
ENDWITH
WAIT CLEAR
RETURN
ENDPROC
Gracias Comunidad de VFP en Español y adelante.
Tonny Molina
genial
ResponderBorrar