procedure TFrm_func.DbGridToExcel( ADg: TDBGrid );
var
xlApp, xlSheet: Variant;
ARow, iLoop: word;
FSaveDialog: TSaveDialog;
Cols:TStringList;
begin
if ADg.DataSource.DataSet.IsEmpty then
begin
Application.MessageBox( PChar( '没有可导出的数据。' ), PChar( '提示' ), MB_OK +
MB_ICONINFORMATION );
Exit;
end;
try
FSaveDialog := TSaveDialog.Create( Self );
FSaveDialog.Filter :=
'Excel 文档 (*.xls)|*.XLS|Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Word 文档 (*.rtf)|*.RTF';
if FSaveDialog.Execute and ( trim( FSaveDialog.FileName ) <> '' ) then
begin
try
xlApp := CreateOleObject( 'Excel.Application' );
xlSheet := xlApp.WorkBooks.Add;
except
Application.MessageBox( PChar( '无法调用Excel' ), PChar( '错误' ), MB_OK +
MB_ICONSTOP );
Exit;
end;
Cols:=TStringList.Create;
// 表格标题
for iLoop := 0 to ADg.Columns.Count - 1 do
begin
xlSheet.WorkSheets[1].Cells[1, iLoop + 1] :=
ADg.Columns[iLoop].Title.Caption;
Cols.Add(ADg.Columns.Items[iLoop].FieldName);
end;
// 数据
ARow := 2;
with ADg.DataSource.DataSet do
begin
DisableControls;
First;
while not Eof do
begin
for iLoop := 0 to Fields.Count - 1 do
begin
if Cols.IndexOf(Fields[iLoop].FieldName)<>-1 then
xlSheet.WorkSheets[1].Cells[ARow,Cols.IndexOf(Fields[iLoop].FieldName)+1] := Fields[iLoop].Value;
// xlSheet.WorkSheets[1].Cells[ARow, iLoop + 1] := Fields[iLoop].Value;
end;
inc( ARow );
Next;
end;
First;
EnableControls;
xlSheet.SaveAs( trim( FSaveDialog.FileName ) );
Application.MessageBox( '导出完毕!', '提示', MB_IconExclamation );
finally
// xlSheet.Close;
xlApp.Visible := False;
xlApp.Quit;
xlApp := UnAssigned;
end;
end;
FSaveDialog.Destroy;
except
on e: exception do
Application.MessageBox( PChar( e.message ), '错误', MB_OK + MB_ICONSTOP );
end;
end;
var
xlApp, xlSheet: Variant;
ARow, iLoop: word;
FSaveDialog: TSaveDialog;
Cols:TStringList;
begin
if ADg.DataSource.DataSet.IsEmpty then
begin
Application.MessageBox( PChar( '没有可导出的数据。' ), PChar( '提示' ), MB_OK +
MB_ICONINFORMATION );
Exit;
end;
try
FSaveDialog := TSaveDialog.Create( Self );
FSaveDialog.Filter :=
'Excel 文档 (*.xls)|*.XLS|Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Word 文档 (*.rtf)|*.RTF';
if FSaveDialog.Execute and ( trim( FSaveDialog.FileName ) <> '' ) then
begin
try
xlApp := CreateOleObject( 'Excel.Application' );
xlSheet := xlApp.WorkBooks.Add;
except
Application.MessageBox( PChar( '无法调用Excel' ), PChar( '错误' ), MB_OK +
MB_ICONSTOP );
Exit;
end;
Cols:=TStringList.Create;
// 表格标题
for iLoop := 0 to ADg.Columns.Count - 1 do
begin
xlSheet.WorkSheets[1].Cells[1, iLoop + 1] :=
ADg.Columns[iLoop].Title.Caption;
Cols.Add(ADg.Columns.Items[iLoop].FieldName);
end;
// 数据
ARow := 2;
with ADg.DataSource.DataSet do
begin
DisableControls;
First;
while not Eof do
begin
for iLoop := 0 to Fields.Count - 1 do
begin
if Cols.IndexOf(Fields[iLoop].FieldName)<>-1 then
xlSheet.WorkSheets[1].Cells[ARow,Cols.IndexOf(Fields[iLoop].FieldName)+1] := Fields[iLoop].Value;
// xlSheet.WorkSheets[1].Cells[ARow, iLoop + 1] := Fields[iLoop].Value;
end;
inc( ARow );
Next;
end;
First;
EnableControls;
end;
FreeAndNil(Cols);
xlSheet.SaveAs( trim( FSaveDialog.FileName ) );
Application.MessageBox( '导出完毕!', '提示', MB_IconExclamation );
finally
// xlSheet.Close;
xlApp.Visible := False;
xlApp.Quit;
xlApp := UnAssigned;
end;
end;
FSaveDialog.Destroy;
except
on e: exception do
Application.MessageBox( PChar( e.message ), '错误', MB_OK + MB_ICONSTOP );
end;
end;
-------------------
一个更加通用的思路:AdoQueryToExcel