[DELPHI]TQuery的结果到入Excel

最新推荐文章于 2023-04-06 09:48:08 发布

todouwang

最新推荐文章于 2023-04-06 09:48:08 发布

阅读量1.6k

点赞数

文章标签： delphi excel integer string microsoft button

[Crystal Studio Web][DELPHI]TQuery的结果到入Excel

TQuery的结果到入Excel

作者:chinawzw 推荐:chinawzw
--------------------------------------------------------------------------------

unit ExcelTest;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls,db,DBTables, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Query1: TQuery;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);
end;

var
Form1: TForm1;

implementation

uses Comobj;

{$R *.DFM}

{ TForm1 }

procedure TForm1.WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);
var
EclApp,WorkBook : Variant;
xlsFileName : String ;
I : Integer ;
column : Integer ;
Row : Integer ;
Fdate:TDateTime;
Year, Month, Day, Hour, Min, Sec, MSec: Word;
StrDate:String ;
StrDate1:String ;
Begin
Fdate:=now ;
DecodeDate(Fdate, Year, Month, Day);
DecodeTime(Fdate, Hour, Min, Sec, MSec);
StrDate:=formatdatetime('yyyy-mm-dd-hh-mm-ss',Fdate) ;
StrDate1:=formatdatetime('yyyy/mm/dd hh:mm:ss',Fdate) ;
If AStrVar='Excel文件测试' Then
Begin
xlsfilename :='Excel文件测试' ;
End ;

Try
Begin
EclApp := CreateOleObject('Excel.Application');
WorkBook:=CreateOleObject('Excel.Sheet');
End
Except
ShowMessage('您的计算机上没有 Microsoft Excel!');
Exit;
end;
try
workBook:=EclApp.workBooks.Add ;
row:=2;
EclApp.Workbooks.Item[1].Activate;
eclApp.Cells.font.colorindex:=5 ;
EclApp.Activesheet.Cells(1,1):=AStrVar ;
For I := 1 To AQueryName.FieldCount Do
EclApp.Activesheet.Cells(2,I):=AQueryName.Fields[I-1].FieldName ;
If Not AQueryName.Active Then AQueryName.Active := True ;
AQueryName.First ;
While Not(AQueryName.Eof) do
begin
column:=1;
for i:=1 to AQueryName.FieldCount do
begin
eclApp.Cells.Item[row+1,column]:=AQueryName.fields[i-1].AsString;
column:=column+1;
end;
AQueryName.Next;
row:=row+1;
End ;
WorkBook.saveas(xlsFileName);
WorkBook.close;
WorkBook:=eclApp.workBooks.Open(xlsFileName);
if MessageDlg('xlsFileName'+'对该文件是否保存?',
mtConfirmation,[mbYes, mbNo], 0) = mrYes then
WorkBook.save
Else
workBook.Saved := True;
WorkBook.Close;
eclApp.Quit;
eclApp:=Unassigned;
except
ShowMessage('Excel 文件保存失败');
WorkBook.close;
eclApp.Quit; {释放VARIANT变量}
eclApp:=Unassigned;
end;
ShowMessage('EXCEL 文件保存完毕') ;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WriteDatasetToExcel(query1,'Excel文件测试');
end;

end.