Exportar Query a Excel

[NACOSTA]

{

***********************************************
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.