procedure TFrmMain.MakeExportXltFile(filename:string);
var
XLApp: Variant;
Sheet: Variant;
begin
try
XLApp:= CreateOleObject('Excel.Application');
XLApp.Visible := false;
except
showmessage('您没有安装Ms Excel ,不能使用本功能') ;
exit;
end;
with DataModule2.ADOQuery1do
begin
close;
SQL.clear;
SQL.Add(StrSQLForExcel+OrderStr);
open;
end;
if DataModule2.ADOQuery1.IsEmpty then
begin
showmessage('当前的查询条件下找不到任何打印记录');
exit;
end;
if FileExists(FileName) then
begin
if MessageBox(handle,Pchar('存在相同名的文件。是否覆盖?'),Pchar('打印监控系统'),MB_YESNO) = IDYES then
DeleteFile(Pchar(SaveDialog1.FileName))
else
exit;
end;
Application.CreateForm(Twaitform, waitform);
waitform.Show();
Application.ProcessMessages;
self.Enabled :=false;
XLApp.Workbooks.Add(-4167);
XLApp.Workbooks[1].WorkSheets[1].Name :='打印统计';
Sheet := XLApp.Workbooks[1].WorkSheets['打印统计'];
Sheet.Cells[1,1]:='文档名';
Sheet.Cells[1,2]:='打印人';
Sheet.Cells[1,3]:='打印机';
Sheet.Cells[1,4]:='打印时间';
Sheet.Cells[1,5]:='页数';
Sheet.Cells[1,6]:='大小(Byte)';
Sheet.Cells[1,7]:='图幅';
Sheet.Cells[1,8]:='系统';
Sheet.Cells[1,9]:='出图类型';
Sheet.Cells[1,10]:='打印份数';
Sheet.Cells[1,11]:='颜色';
sheet.cells[2,1].copyfromrecordset(DataModule2.ADOQuery1.recordset);
try
sheet.Saveas(filename);
except
showmessage('请确定文件'+filename+'没有被打开');
end;
XLApp.Quit;
waitform.close();
showmessage('Export Success!');
self.Enabled :=true;
end;
procedure TFrmMain.BitBtnExportClick(Sender: TObject);
begin
SaveDialog1.InitialDir := 'c:/';
SaveDialog1.FileName := 'Excel.xls';
if SaveDialog1.Execute then
begin
MakeExportXltFile(SaveDialog1.FileName);
end;
end;