Saludos a todos los participantes, a continuación les anexo una librería que me encontré (y que posteriormente modifiqué para cubrir mis necesidades) mediante la cual genero archivos de Microsoft Excel a partir de DataSets o Grids.
Que tengan buen día.
Código Delphi
[-]
unit ExportarAExcel;
interface
uses
DB, DBGrids, ADOX_TLB, ADODB,
SysUtils, Forms, Types, ExtCtrls, Controls, Gauges;
type TScrollEvents = class
BeforeScroll_Event: TDataSetNotifyEvent;
AfterScroll_Event: TDataSetNotifyEvent;
AutoCalcFields_Property: Boolean;
end;
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
procedure DataSetAExcel(DataSet: TDataSet; FileName: string; SheetName: string);
procedure GridAExcel(DBGrid: TDBGrid; FileName: string; SheetName: string);
implementation
function Quitar_caracteres(sCadena: string): string;
const sEsto: string = '.-/ ';
var i, j: Integer;
begin
Result := '';
for i := 1 to Length(sEsto) do begin
j := Pos(sEsto[i], sCadena);
while (j <> 0) do begin
Result := Result + Copy(sCadena, 1, j - 1) + '_';
Delete(sCadena, 1, j);
j := Pos(sEsto[i], sCadena);
end;
if sCadena = '' then Break;
end;
Result := Result + sCadena;
end;
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
begin
with DataSet do begin
DisableControls;
ScrollEvents := TScrollEvents.Create();
with ScrollEvents do begin
BeforeScroll_Event := BeforeScroll;
AfterScroll_Event := AfterScroll;
AutoCalcFields_Property := AutoCalcFields;
BeforeScroll := nil;
AfterScroll := nil;
AutoCalcFields := False;
end;
end;
end;
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
begin
with DataSet do begin
EnableControls;
with ScrollEvents do begin
BeforeScroll := BeforeScroll_Event;
AfterScroll := AfterScroll_Event;
AutoCalcFields := AutoCalcFields_Property;
end;
end;
end;
procedure DataSetAExcel(DataSet: TDataSet; FileName: string; SheetName: string);
var
cat: _Catalog;
tbl: _Table;
col: _Column;
i: integer;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
ScrollEvents: TScrollEvents;
SavePlace: TBookmark;
Forma: TForm;
Panel: TPanel;
pbAvance: TGauge;
begin
cat := CoCatalog.Create;
cat.Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0;');
tbl := CoTable.Create;
tbl.Set_Name(SheetName);
DataSet.First;
with DataSet.Fields do begin
for i := 0 to Count - 1 do begin
col := nil;
col := CoColumn.Create;
with col do begin
Set_Name(Fields[i].DisplayName);
Set_Type_(adVarWChar);
end;
tbl.Columns.Append(col, adVarWChar, 20);
end;
end;
try
cat.Tables.Append(tbl);
except
raise exception.Create('No se pudo generar el libro, a parecer ya existe en el archivo.');
end;
col := nil;
tbl := nil;
cat := nil;
ADOConnection := TADOConnection.Create(nil);
ADOConnection.LoginPrompt := False;
ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0';
ADOQuery := TADOQuery.Create(nil);
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Text := 'SELECT * FROM [' + SheetName + ']';
ADOQuery.Open;
DisableDependencies(DataSet, ScrollEvents);
SavePlace := DataSet.GetBookmark;
Forma := TForm.Create(Application);
try
Forma.Canvas.Font := Forma.Font;
Forma.BorderStyle := bsNone;
Forma.ClientWidth := 380;
Forma.ClientHeight := 60;
Forma.Position := poScreenCenter;
Forma.FormStyle := fsStayOnTop;
Panel := TPanel.Create(Forma);
Panel.Align := alClient;
Panel.BevelInner := bvRaised;
Panel.BevelOuter := bvLowered;
Panel.Caption := '';
pbAvance := TGauge.Create(Panel);
pbAvance.Parent := Forma;
pbAvance.MinValue := 0;
pbAvance.MaxValue := 100;
pbAvance.Progress := 0;
pbAvance.Left := 40;
pbAvance.Top := 20;
pbAvance.Width := 320;
pbAvance.Height := 20;
Forma.Show;
try
with DataSet do begin
First;
while not Eof do begin
pbAvance.Progress := Trunc(RecNo / RecordCount * 100);
pbAvance.Update;
ADOQuery.Append;
with Fields do begin
ADOQuery.Edit;
for i := 0 to Count - 1 do
ADOQuery.FieldByName(Fields[i].DisplayName).AsString :=
FieldByName(Fields[i].FieldName).AsString;
ADOQuery.Post;
end;
Next;
end;
end;
finally
DataSet.GotoBookmark(SavePlace);
DataSet.FreeBookmark(SavePlace);
EnableDependencies(DataSet, ScrollEvents);
ADOQuery.Close;
ADOConnection.Close;
ADOQuery.Free;
ADOConnection.Free;
end;
finally
Forma.Free;
end;
end;
procedure GridAExcel(DBGrid: TDBGrid; FileName: string; SheetName: string); overload;
begin
DataSetAExcel(DBGrid.DataSource.DataSet, FileName, SheetName);
end;
end.