RE:OLVIDE RE:Reportes (PDF, DOC, ETC)
hola amigo te mando un ejemplo para exportarlo a excel , yo lo uso y anda barbaro :
CLOSE DATABASES
USE sistemaarticulo shared
set order to prove && Opens Customer table.
select codint,desartic,desprov ,p_lista,p_lista2,p_lista3 from articulo order by desprov,desartic into cursor arti
select arti
set dele on
go top
cArchivo = Putfile("Archivo a generar","","XLS")
IF EMPTY(carchivo) && Esc presionada
RETURN
ENDIF
*----------------------------------- otra manera de exportar
*gcDelimName = ALIAS( ) + '.XLS'
*gcDelimFile = PUTFILE('Nombre de archivo:', gcDelimName, 'XLS')
*IF EMPTY(gcDelimFile) && Esc presionada
* RETURN
*ENDIF
*Wait Windows "Convirtiendo tabla a hoja de cálculo." + CHR(13) +;
*"Espere uno segundos por favor..." NOWAIT
*COPY TO (gcDelimFile) TYPE XL5
*=messagebox("tarea completada...",0+32,"veter 1.5")
*return
*---------------------------------------------------------------------------
CopyToExcel("arti"," Datos Exportados", "", "", "Listado de Artículos por Proveedor", .f., cArchivo)
use
return
Function CopyToExcel
Lparameters cTabla,cTitulo,cDesde,cHasta,cEmpresa,cproteg, cNombreArch
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,cTitulo)
Close Tables
Return
Endif
*---------------------------------------------------------
*-- EXPORTA LA TABLA
*---------------------------------------------------------
Wait Window "Abriendo MS Excel..." Nowait
Select (AreaTabla)
*-- Nombre y path de la hoja
If Pcount() = 7
TxtFileName = Fullpath(cNombreArch)
Else
TxtFileName = Fullpath("reportsExprt_Excel"+Usuario)
Endif
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(cEmpresa))
.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 = 8
Endwith
*--Fuente para el titulo del reporte
.Range("A1:A1").Select
With .Selection.Font
.Name = "Arial"
.Size = 10
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
.save()
.Visible = .T.
Endwith
Wait Clear
Return
saludos y espero te sirva
