Exportar Query a Excel
 

{

***********************************************
Fecha : Julio 2008
Autor : Noe Acosta
** Tome el ejemplo base de internet hace mas de un año ,
no recuerdo el autor ni el sitio.., e visto algunos ejemplos
usando CreateOleObject('Excel.Application')................
con esta funcion ocupa la VCL Servers de Delphi............
Modifique la funcion para que permita mandarle datos desde
un query..., por el momento, solo pasa columnas con tipo
de datos string (@)... ......
lo dejo ahi por si alguien de ustedes se le ocurre algo mejor
o puede ayudarme a mejorarla......
funcion : Exportar datos a .excel
Agosto 2008 : Modificacion Para llamar funcion con cualquier
Query..






**********************************************

para usar esta funcion: colocar en el uses ToExcel..
para ejcutarla por ejemplo desde el eveto onclick de un boton
llamarla asi: aexcel(query1);
}


unit ToExcel;

interface

Uses Windows, SysUtils,Variants, Classes, Forms, Dialogs,DB,
IBQuery, Grids, DBGrids, Excel2000;

procedure AExcel(ibquery1:TIBQuery);

implementation

var
FormatCel : array of OleVariant;
SeprDec : string;
ExcelApp : TExcelApplication;
ExcelBook : TExcelWorkbook;
WS : TExcelWorksheet;



procedure AExcel(ibquery1:TIBQuery);
procedure FormatosCeldas(N: Integer);
var I: Byte;
begin
{
EN ESTE PROCEDIMIENTO DEFINIMOS EL FORMATO DE NUMERO PARA LOS CAMPOS
QUE ASI LO REQUIERAN. LOS CAMPOS QUE NO SE INDIQUEN A TRAVES DE LA
VARIABLE "FormatCel" SE LES DA EL VALOR '@' QUE EQUIVALE EN EXCEL
A TEXTO.-
}
//INICIAMOS LA VARIABLE "FormatCel" POR LA CANTIDAD DE CAMPOS POR CADA
//CONSULTA DE BASE DE DATOS QUE TENGAMOS EN PANTALLA:
for I:= 1 to N do FormatCel[i]:= Null;
//EL "ComboBox1" ENLISTA LOS ARCHIVOS "DBF".- CADA CUAL EN ESTE
//PROCEDIMIENTO VERA LA FORMA DE ACCEDER A CADA CONSULTA.-
{ if ComboBox1.ItemIndex = 0 then
begin}
// FormatCel[0]:= '00';
// FormatCel[1]:= '00';
// FormatCel[2]:= '@';
// FormatCel[4]:= '00' + SeprDec + '00';
{ end;

if ComboBox1.ItemIndex = 1 then
begin
FormatCel[1]:= '000000';
FormatCel[3]:= 'dd/mm/yyyy';
FormatCel[4]:= 'dd/mm/yyyy';
end;

if ComboBox1.ItemIndex = 2 then
begin
FormatCel[4]:= '00' + SeprDec + '00'; //00.00 ó 00,00
FormatCel[5]:= '00' + SeprDec + '00';
FormatCel[6]:= '00' + SeprDec + '00';
FormatCel[7]:= '00' + SeprDec + '00';
FormatCel[8]:= '00' + SeprDec + '00';
end;
}
for I:= 1 to N do if FormatCel[i] = Null then FormatCel[i]:= '@';
end;
var Lcid, C, CH, CH1, I, W, X, Y, TotHoja: Integer; Bk: TBookmarkStr;
Tabla : Variant;
L, A : OleVariant;
HH : Extended;
tit : string;
f : TExtFile; // Archivo de texto
DataSource1 : TDataSource;
DBg : TDBGrid;
begin

DataSource1 := TDataSource.Create(DataSource1);
Dbg := TDBGrid.Create(Dbg);
ExcelApp := TExcelApplication.Create(ExcelApp);
ExcelBook := TExcelWorkbook.Create(ExcelBook);
WS := TExcelWorksheet.Create(WS);

try


ibquery1.Open;
ibquery1.First;

DataSource1.DataSet := ibquery1;
Dbg.DataSource := DataSource1;

if not IBQuery1.Active then Exit;
if IBQuery1.RecordCount = 0 then Exit;

Lcid:= GetUserDefaultLCID;

C:= Dbg.Columns.Count; //CANTIDAD DE COLUMNAS

CH:= 1;

if IBQuery1.RecordCount > 15100 then
begin
HH:= IBQuery1.RecordCount / 15100;
CH:= Trunc(HH);
if Frac(HH) > 0 then CH:= CH + 1;
end;

ExcelApp.Visible[Lcid]:= True;
ExcelApp.Caption:= 'Consultas en EXCEL';

//LA PRIMER HOJA SE CREA AL CONECTAR EL "ExcelBook"
ExcelBook.ConnectTo(ExcelApp.Workbooks.Add(1, Lcid));

//SI EL LIBRO ES DE UNA SOLA HOJA SE DA UN SOLO NOMBRE:
//if CH = 1 then WS.Name:= Tit;

//DESACTIVAR EL REFRESCO DE EXCEL EN PANTALLA:
//ExcelApp.ScreenUpdating[Lcid]:= False;

for X:= 1 to CH do
begin
WS.ConnectTo(ExcelBook.Worksheets[X] as _Worksheet);
WS.Activate(Lcid);
for I:= 0 to (C - 1) do
begin
L:= WS.Cells.Item[1, I + 1]; //DEFINE LA COLUMNA DE LA HOJA: "A1:A1", "B1:B1", ETC.
WS.Range[L, L].Value2:= DBG.Columns[i].Title.Caption;
end;
end;
//ACTIVAR LA HOJA NRO. 1:
WS.ConnectTo(ExcelBook.Worksheets[1] as _Worksheet);
WS.Activate(Lcid);

//INICIAMOS VARIABLES:
CH1:= 1;
W:= 2;
I:= 1;
Y:= 1;
TotHoja:= 0;
Datasource1.DataSet.DisableControls; //DESACTIVA EL TDataSource
Bk:= Datasource1.DataSet.Bookmark; //MEMORIZA EL REGISTRO ACTIVO DEL TDataSource

//LA VARIABLE "Tabla" ES UN ARRAY AL CUAL LO VOY DESCARGANDO A EXCEL CADA
//5000 FILAS.- ESTE NUMERO SE DEBERA MANEJAR CON MUCHO CUIDADO YA QUE
//SI UNA CONSULTA EN PANTALLA CONTIENE, POR DECIR, 30 CAMPOS, LO MAS
//PROBABLE ES QUE HAYA QUE DISMINUIR DE 5000 A 4000, POR EJEMPLO. O IR
//PROBANDO SI ES QUE DURANTE LA EXPORTACION OCURRE UN ERROR.-
//CABE ACLARAR QUE ESTE PROCESO ES UN TANTO INESTABLE DE ACUERDO A LOS
//PARAMETROS QUE MANEJEMOS.-
//A CONTINUACION COMIENZA EL PROCESO DE EXPORTACION A "EXCEL":

//CREAMOS LA VARIABLE CON PARAMETROS INICIALES:
//1 a 5000, 0 a nro. de campos(C)
Tabla:= VarArrayCreate([1, 5000, 0, C], varVariant);
Datasource1.DataSet.First;
while not Datasource1.DataSet.Eof do
begin
for X:= 0 to (C - 1) do
BEGIN
Tabla[Y, X]:=
Datasource1.DataSet.Fields[X].AsString;
//SHOWMESSAGE(Datasource1.DataSet.Fields[X].AsString);
END;

{
LA LINEA ANTERIOR ES EL EQUIVALENTE A:
Tabla[1, 0]:= Valor del campo cero de la consulta en pantalla en el registro "1"
Tabla[1, 1]:= Valor del campo uno de la consulta en pantalla en el registro "1"
Tabla[1, 2]:= Valor del campo dos de la consulta en pantalla en el registro "1"
...
...
Tabla[5000, 0]:= Valor del campo cero de la consulta en pantalla en el registro "5000"
Tabla[5000, 1]:= Valor del campo uno de la consulta en pantalla en el registro "5000"
Tabla[5000, 2]:= Valor del campo dos de la consulta en pantalla en el registro "5000"
}
if Y = 5000 then //CADA 5000 REGISTROS EXPORTAMOS A EXCEL
begin
L:= 'A' + IntToStr(W); //DEFINE LA CELDA DE INICIO.-
{
LA SIGUIENTE LINEA EXPORTA A EXCEL A TRAVES DE RANGOS DEFINIDOS,
POR EJEMPLO: DE LA CELDA "A1" A LA CELDA "F5000":
WS.Range['A1', 'F5000'].Value2:= Tabla; }
WS.Range[L, WS.Cells.Item[I + 1, C]].Value2:= Tabla;
//DESCARGAMOS LA VARIABLE "Tabla":
try
Tabla:= Unassigned;
finally
//CREAR "Tabla" CON PARAMETROS DE INICIO:
Tabla:= VarArrayCreate([1, 5000, 0, C], varVariant);
end;
Y:= 0; //REINICIA CANTIDAD DE REGISTROS PARCIALES PARA EXPORTAR A LA HOJA
W:= I + 2; //"W" ES LA FILA DONDE REINICIA LA HOJA LUEGO DE EXPORTACION PARCIAL
end;
Inc(Y, 1); //CANTIDAD DE REGISTROS PARCIALES PARA EXPORTAR A LA HOJA
Inc(I, 1); //CONTADOR DE REGISTROS DEL "TDataSource (TDs)" (POR CADA HOJA EXCEL COMIENZA EN "1")
Inc(TotHoja, 1); //CONTADOR DE CANTIDAD DE FILAS POR HOJA
if TotHoja = 15100 then //FINAL DE CADA HOJA
begin
L:= 'A' + IntToStr(W);
WS.Range[L, WS.Cells.Item[I, C]].Value2:= Tabla;
try
Tabla:= Unassigned;
finally
Tabla:= VarArrayCreate([1, 5000, 0, C], varVariant);
end;
CH1:= CH1 + 1; //NRO DE HOJA
WS.ConnectTo(ExcelBook.Worksheets[CH1] as _Worksheet);
WS.Activate(Lcid);
//REINICIAMOS LAS SIGUIENTES VARIABLES:
Y:= 1;
W:= 2;
I:= 1;
TotHoja:= 0;
end;
Application.ProcessMessages;
datasource1.DataSet.Next;
End;
{
SI LA CANTIDAD DE HOJAS EXCEL ES "UNO", LA CONDICION
"if TotHoja = 65100 then" NO TENDRA EFECTO.-
LO MISMO SI LA CANTIDAD DE REGISTROS NO LLEGA A 5000, LA CONDICION
"if Y = 5000 then" NO TENDRA EFECTO.- SI SUCEDE ESTO ULTIMO, LA
EXPORTACION A EXCEL SE DA EN EL SIGUIENTE PASO.-
}

//EL SIGUIENTE PASO EXPORTA EL REMANENTE DE "Y" A LA HOJA
//O SI NO SE DIO LA CONDICION "if Y = 5000 then".-
CH1:= I; //MEMORIZAMOS LA CANTIDAD DE FILAS DE LA ULTIMA HOJA(O LA UNICA).-
try
WS.Range['A' + IntToStr(W), WS.Cells.Item[CH1, C]].Value2:= Tabla;
finally
Tabla:= Unassigned;
end;

//A CONTINUACION DEFINIMOS EL FORMATO DE CELDAS DE LAS HOJAS DE EXCEL:
for X:= 1 to CH do //CONTADOR DE HOJAS CREADAS PARA EXCEL.-
begin
//ACTIVAR HOJA
WS.ConnectTo(ExcelBook.Worksheets[X] as _Worksheet);
WS.Activate(Lcid);
//EL SIGUIENTE PASO ES APLICAR FORMATO NUMERICO A CADA COLUMNA:
SetLength(FormatCel, C + 1); //REINICIA "FormatCel"
FormatosCeldas(C);
for I:= 1 to C do
begin
L:= WS.Cells.Item[1, I];
WS.Range[L, L].EntireColumn.NumberFormat:= FormatCel[i];
end;
//EL SIGUIENTE PASO ES APLICAR ANCHOS DE COLUMNA Y JUSTIFICACION:
for I:= 0 to (C - 1) do //CONTADOR DE CAMPOS
Begin
L:= WS.Cells.Item[1, I + 1]; //A1 B1 C1 D1....Z1....AA AB ,etc.
Y:= Datasource1.DataSet.Fields[i].DisplayWidth;
if Length(dbg.Columns[i].Title.Caption) > Y then
Y:= Length(Dbg.Columns[i].Title.Caption);
WS.Range[L, L].EntireColumn.ColumnWidth:= Y + 2;
if Dbg.Columns[i].Alignment = taLeftJustify then A:= 2;
if Dbg.Columns[i].Alignment = taCenter then A:= 3;
if Dbg.Columns[i].Alignment = taRightJustify then A:= 4;
WS.Range[L, L].EntireColumn.HorizontalAlignment:= A;
End;

end;
WS.ConnectTo(ExcelBook.Worksheets[1] as _Worksheet);
WS.Activate(Lcid);
ExcelBook.DefaultInterface.Author[Lcid]:= 'NOE ACOSTA';
//ACTIVAR EL REFRESCO DE EXCEL EN PANTALLA
ExcelApp.ScreenUpdating[Lcid]:= True;
datasource1.DataSet.EnableControls; //ACTIVA EL "TDataSource"
datasource1.DataSet.Bookmark:= Bk; //REGISTRO QUE ESTABA ACTIVO ANTES DE EXPORTAR

except


ShowMessage('Error al Generar Hoja Electronica..');

end;//try


END;



end.

Hola Noe, hace unos minutos vi un procedimiento similar, creado por Andre_Marcel en el 2005. El sitio es http://www.q3.nu/trucomania/ en el foro más reciente. te envío una copia, y como dije lo acabo de ver y aún no lo he probado.


procedimiento que efectua la exp.
procedure TMDMain.ExportaExcel(oQuery:TQuery; bCabecera, bAbrirArchivo, bSoloFldVisible:Boolean);
var archivo_a_escribir_Aux ,nom_archivo, exte_archivo : string;
archivo_a_escribir :textfile;
i,sw_tit: integer;
begin
sw_tit := 0;
oQuery.ExecSQL;

if oQuery.RecordCount > 0 then
begin

SaveDlg.Filter := 'Archivos Excel (*.csv)|*.csv';
SaveDlg.InitialDir:= 'C:\';
SaveDlg.FileName:= '';
if SaveDlg.Execute then
begin
archivo_a_escribir_Aux:= SaveDlg.filename;
assignfile(archivo_a_escribir, archivo_a_escribir_Aux);
{$I-}
rewrite(archivo_a_escribir);
{$I+}
if ioresult = 32 then
ShowMessage('Error: Archivo abierto por otra aplicación...')
else
begin
oQuery.DisableControls;
oQuery.First;
While not oQuery.Eof do
begin
// Generar Titulo de Campos
if bCabecera then
begin
if sw_tit = 0 then
begin
sw_tit := 1;
for i := 0 to oQuery.FieldCount - 1 do
begin
if bSoloFldVisible then
begin
if oQuery.Fields[i].Visible then
begin
write(archivo_a_escribir, oQuery.Fields[i].DisplayLabel);
write(archivo_a_escribir, ';');
flush(archivo_a_escribir);
end;
end
else
begin
write(archivo_a_escribir, oQuery.Fields[i].DisplayLabel);
write(archivo_a_escribir, ';');
flush(archivo_a_escribir);
end;
end;
writeln(archivo_a_escribir,' ');
end;
end;
//Datos
for i := 0 to oQuery.FieldCount - 1 do
begin
if bSoloFldVisible then
begin
if oQuery.Fields[i].Visible then
begin
write(archivo_a_escribir, oQuery.Fields[i].AsString);
write(archivo_a_escribir, ';');
flush(archivo_a_escribir);
end;
end
else
begin
write(archivo_a_escribir, oQuery.Fields[i].AsString);
write(archivo_a_escribir, ';');
flush(archivo_a_escribir);
end;
end;

writeln(archivo_a_escribir,' ');
oQuery.Next;
end;
oQuery.EnableControls;
CloseFile(archivo_a_escribir);

if bAbrirArchivo then
Ver_Archivo(SaveDlg.FileName, ExtractFilePath(SaveDlg.FileName)) // Procedimiento 2
else
MessageBox(hManejador, 'Archivo Generado', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION);
end;
end;
end
else
MessageBox(hManejador, 'No hay Registros', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION);

end;


procedimiento para abrir archivo de excel desde delphi
procedure TMDMain.Ver_Archivo(cNom_Archivo, cRuta_Archivo:String);
var ErrorCod: Integer;
begin
if (Trim(cNom_Archivo) <> '') and (Trim(cRuta_Archivo) <> '') then
if Trim(ExtractFileExt(cRuta_Archivo+'\'+cNom_Archivo)) <> '' then
ErrorCod:= ShellExecute(0, 'Open', PChar(cNom_Archivo), Nil, PChar(cRuta_Archivo), SW_SHOWNORMAL)
else
exit;

Case ErrorCod of
ERROR_FILE_NOT_FOUND : begin
MessageBox(hManejador, 'Archivo no Encontrado', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION);
end;

ERROR_PATH_NOT_FOUND : begin
MessageBox(hManejador, 'Ruta de Archivo no Encontrado', VG_NOMBRE_APLICACION , MB_OK + MB_ICONINFORMATION);
end;

SE_ERR_NOASSOC : begin
MessageBox(hManejador, 'No se ha encontrado un programa para abrir este tipo de archivo', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION);
end;

else
if ErrorCod < 32 then // Códigos de error de ejecución no exitosa
MessageBox(hManejador, 'Error al abrir archivo', VG_NOMBRE_APLICACION, MB_OK + MB_ICONERROR);

end //Case ErrorCod of
end;


ejemplo de llamada para exportación:

// Exportar desde Grilla--> oQuery;bCabecera, bAbrirArchivo, bSoloFldVisible
MDMain.ExportaExcel(TQuery(Grilla_DatosX.DataSource.DataSet), True, True, False);

// Exportar desde Query--> oQuery;bCabecera, bAbrirArchivo, bSoloFldVisible
MDMain.ExportaExcel(QueryXX, True, True, False);

Muy interesante, quizas les cambie radicalmente el tema pero ojala haya alguien que ya se haya topado con esto ya que no he podido dar con la solucion... quisiera saber si alguien sabe como hacerle para indicar que un archivo se genera en office 2007 pero con extension del office 2003? Me refiero a lo siguiente: en la parte superior del codigo se especifica lo siguiente:

Uses Excel2000;

hasta hay todo esta ok, pero hice un codigo muy sencillo para generar reporte que manda a un archivo de excel, automaticamente cierra el archivo al terminar de generarlo y automaticamente lo manda por correo, yo tengo office 2003 y no hay problema cuando hago las pruebas en mi pc pero el usuario final que utilizara el reporteador tiene office 2007 asi que cuando manda el reporte a sus contactos ellos no pueden abrir el archivo ya que aunque se genero el archivo con extension xls este mismo fue generado con excel 2007.

Se supone que excel 2007 puede abrir archivos del excel 2003 entonces asi que no he podido dar con el problema. Por el momento tuve que instalarle al usuario excel 2003, de esta forma el archivo se genera, se manda y los destinatarios lo pueden abrir sin problema. Es un problema de versiones pero como podria hacer para que aunque el usuario tenga office 2007 pueda generar un archivo de office 2003 y los que reciben no tengan problema... los que reciben tienen office 2003 tambien.

Gracias de antemano