.....
USES ComObj ;
.....
procedure Exportar_Grilla_Excel(FileName:String; Grilla: TDBGrid; ProgressBarXls: TProgressBar);
procedure ProgressBarInit;
begin
ProgressBarXls.Max := Grilla.DataSource.DataSet.RecordCount;
ProgressBarXls.Position := 0;
ProgressBarXls.Visible := True;
end;
var ExcelApp, Libro: Variant;
Nombre : string;
fila, i, j :integer;
PBookmark: TBookmark;
begin
ForceDirectories(ExtractFilePath(ParamStr(0)) + 'Reportes');
SaveDialog1.Title := 'Exportando Reporte a Excel';
SaveDialog1.DefaultExt := 'xls';
SaveDialog1.InitialDir := ExtractFilePath(ParamStr(0)) + 'Reportes';
SaveDialog1.FileName:= FileName+'.xls';
SaveDialog1.Filter:='Archivos Excel (*.xls)|*.xls';
SaveDialog1.FilterIndex:=1;
try
SaveDialog1.Execute;
if (SaveDialog1.FileName<>'') then
begin
if (ProgressBarXls <> nil) then
ProgressBarInit;
PBookmark := Grilla.DataSource.DataSet.GetBookmark;
Grilla.DataSource.DataSet.DisableControls;
ExcelApp:=CreateOleObject('Excel.Application');
Nombre:= SaveDialog1.FileName;
ExcelApp.DisplayAlerts:=false;
ExcelApp.WorkBooks.Add();
ExcelApp.WorkBooks[1].ActiveSheet.Name := FileName;
Libro := ExcelApp.WorkBooks[1].ActiveSheet;
Libro.PageSetup.Orientation := 1;
fila:=1;
for i:= 0 to Grilla.Columns.Count-1 do
begin
Libro.Cells[fila,i+1]:= Grilla.Columns[i].Title.Caption;
Libro.Cells[fila,i+1].Font.Bold := True;
Libro.Cells[fila,i+1].font.Size := 12;
Libro.Cells[fila,i+1].font.Color := clWhite;
Libro.Cells[fila,i+1].Interior.Color := clGray ;
Libro.Cells[fila,i+1].HorizontalAlignment := xlcenter ;
end;
inc(fila);
Grilla.DataSource.DataSet.First;
for i:= 1 to Grilla.DataSource.DataSet.RecordCount do
begin
for j:= 0 to Grilla.Columns.Count-1 do
begin
case Grilla.Columns[j].Alignment of
taLeftJustify: Libro.Cells[fila,j+1].HorizontalAlignment := xlLeft;
taRightJustify: Libro.Cells[fila,j+1].HorizontalAlignment := xlRight;
taCenter: Libro.Cells[fila,j+1].HorizontalAlignment := xlCenter;
end;
case Grilla.Fields[J].DataType of
ftAutoInc, ftBytes, ftInteger, ftSmallint, ftWord: begin
Libro.Cells[fila,j+1].NumberFormat := '0';
Libro.Cells[fila, J +1] := Grilla.Fields[J].AsInteger;
end;
ftBCD, ftFloat, ftCurrency: begin
Libro.Cells[fila,j+1].NumberFormat := '0.00';
Libro.Cells[fila, J +1] := Grilla.Fields[J].AsFloat;
end;
ftDateTime, ftDate, ftTime: begin
Libro.Cells[fila, J +1] := Grilla.Fields[J].AsDateTime;
end;
else begin
Libro.Cells[fila,j+1].NumberFormat := RPad('0', '0', Length(Grilla.Fields[J].AsString));
Libro.Cells[fila,J+1]:= Grilla.Fields[J].AsString ;
end;
end;
end;
Grilla.DataSource.DataSet.Next;
inc(fila);
if (ProgressBarXls <> nil) then
ProgressBarXls.Position := ProgressBarXls.Position +1;
end;
if (ProgressBarXls <> nil) then
ProgressBarXls.Visible := False;
Libro.Cells.Columns.AutoFit;
Libro.SaveAs(Nombre);
ExcelApp.Visible := true;
Grilla.DataSource.DataSet.GotoBookmark(PBookmark);
Grilla.DataSource.DataSet.FreeBookmark(PBookmark);
Grilla.DataSource.DataSet.EnableControls;
end;
except
ExcelApp.Quit;
if (ProgressBarXls <> nil) then
ProgressBarXls.Visible := False;
Grilla.DataSource.DataSet.GotoBookmark(PBookmark);
Grilla.DataSource.DataSet.FreeBookmark(PBookmark);
Grilla.DataSource.DataSet.EnableControls;
showmessage('No se pudo crear el Archivo Excel.');
raise;
end;
end;