Delphi DBGRid导出问题
这是我在网上找的一个方法
unit DBGRIDexel;
interface
uses ComObj,DBGrids,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls, StdCtrls;
function ExportDBGrid(DBGrid: TDBGrid; SaveDialog:TSaveDialog;SaveFileName: string): boolean;
implementation
function ExportDBGrid(DBGrid: TDBGrid; SaveDialog:TSaveDialog ;SaveFileName: string): boolean;
var
c,r,i,j: integer;
app: Olevariant;
TempFileName, ResultFileName: string;
begin
try
result := True;
app := CreateOLEObject('Excel.application');
except
Application.MessageBox('Excel没有正确安装！','警告',MB_OK);
result := False;
exit;
end;
SaveDialog.DefaultExt := '.xls';
SaveDialog.FileName:=SaveFileName;
if SaveDialog.Execute then
TempFileName := SaveDialog.FileName
else
Exit;
app.Workbooks.add;
app.Visible := false;
Screen.Cursor := crHourGlass;
DBGrid.DataSource.DataSet.First;
c:=DBGrid.DataSource.DataSet.FieldCount;
r:=DBGrid.DataSource.DataSet.RecordCount;
Application.ProcessMessages;
for i:=0 to c-1 do
begin
app.ActiveSheet.Columns[i+1].ColumnWidth:=10;//设置格宽度
app.cells(1,1+i):=DBGrid.DataSource.DataSet.Fields[i].DisplayLabel;
end;
for j := 1 to r do
begin
for i := 0 to c - 1 do
begin
app.cells[j+1,3].numberformatlocal:='@';//设置成文本
app.cells(j+1,1+i):=DBGrid.DataSource.DataSet.Fields[i].AsString;
end;
DBGrid.DataSource.DataSet.Next;
end;
ResultFileName := TempFileName;
if ResultFileName = '' then
ResultFileName := '数据导出';
if FileExists(TempFileName) then
DeleteFile(TempFileName);
app.Activeworkbook.saveas(TempFileName);
app.Activeworkbook.close(false);
app.quit;
app := unassigned;
end;
end.
