使用 ComObj 中的
FExcelApp := CreateOleObject( 'Excel.Application' );
生成了一个 Excel 表格对象
但是
FExcelApp.WorkBooks.Close;
FExcelApp.Quit
后,依然有 EXCEL.exe 进程 ,如何去掉,
经证实,可以加上这么一句,就能完全解决
FExcelApp:= unassigned;
哈哈,真好用!
你在uses里面要使用Variants这个单元
var
ExcelApp:Variant;
MyWorkBook: Variant;
i: byte;
j, a: integer;
s, k, b, CustomAttrs: string;
begin
try
ExcelApp := CreateOleObject( 'Excel.Application ');
MyWorkBook := CreateOleObject( 'Excel.Sheet ');
except
on Exception do raise exception.Create( '无法打开Excel文件,请确认已经安装Execl ')
end;
MyWorkBook := ExcelApp.WorkBooks.Add;
MyWorkBook.WorkSheets[1].Range[ 'A1:D1 '].Merge(True);
MyWorkBook.WorkSheets[1].Range[ 'A1:D2 '].HorizontalAlignment := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Cells[1, 1].Value := Title;
with FDataSet do
begin
i := 2;
for j := 0 to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
b := Fields[j].DisplayLabel;
CustomAttrs := ' ';
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, 1, i,
Fields[j].FieldName, CustomAttrs, b);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;
end;
end;
i := 3;
Close;
Open;
First;
a := 2;
while not Eof do
begin
for j := 0 to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
CustomAttrs := ' ';
k := Fields[j].Text;
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, i, a,
Fields[j].FieldName, CustomAttrs, k);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;
inc(a);
end;
end;
Inc(i);
Next;
end;
end;
s := 'A3:D ' + IntToStr(i - 1);
s := 'A1:D ' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth := 20;
MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth := 25;
MyWorkBook.WorkSheets[1].Rows[1].RowHeight := 50;
MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Range[s].Font.Name := '仿宋 ';
s := 'A2:D ' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;
MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally := True;
MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1 ';
try
MyWorkBook.Saveas(FileName);
MyWorkBook.Close;
except
MyWorkBook.Close;
end;
ExcelApp.Quit;
ExcelApp := UnAssigned;
end;
我用的是下面的代码
首先要创建一个公共单元,名字你们可以随便起。
以下是我创建的公共单元的全部代码:
unit UnitDatatoExcel;
interface
uses
Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
DB, ComObj;
type
TKHTMLFormatCellEvent = procedure(Sender: TObject; CellRow,CellColumn: Integer; FieldName: string;
var CustomAttrs, CellData: string) of object;
TDataSetToExcel = class(TComponent)
private
FDataSet: TDataSet;
FOnFormatCell: TKHTMLFormatCellEvent;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Transfer(const FileName: string; Title: string = ' ');
published
property DataSet: TDataSet read FDataSet write FDataSet;
end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begin
inherited;
end;
procedure TDataSetToExcel.Transfer(const FileName:string;Title:string = ' ');
var
ExcelApp, MyWorkBook: Variant;
i: byte;
j, a: integer;
s, k, b, CustomAttrs: string;
begin
try
ExcelApp := CreateOleObject( 'Excel.Application ');
MyWorkBook := CreateOleObject( 'Excel.Sheet ');
except
on Exception do raise exception.Create( '无法打开Excel文件,请确认已经安装Execl ')
end;
MyWorkBook := ExcelApp.WorkBooks.Add;
MyWorkBook.WorkSheets[1].Range[ 'A1:D1 '].Merge(True);
MyWorkBook.WorkSheets[1].Range[ 'A1:D2 '].HorizontalAlignment := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Cells[1, 1].Value := Title;
with FDataSet do
begin
i := 2;
for j := 0 to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
b := Fields[j].DisplayLabel;
CustomAttrs := ' ';
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, 1, i,
Fields[j].FieldName, CustomAttrs, b);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;
end;
end;
i := 3;
Close;
Open;
First;
a := 2;
while not Eof do
begin
for j := 0 to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
CustomAttrs := ' ';
k := Fields[j].Text;
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, i, a,
Fields[j].FieldName, CustomAttrs, k);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;
inc(a);
end;
end;
Inc(i);
Next;
end;
end;
s := 'A3:D ' + IntToStr(i - 1);
s := 'A1:D ' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth := 20;
MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth := 25;
MyWorkBook.WorkSheets[1].Rows[1].RowHeight := 50;
MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Range[s].Font.Name := '仿宋 ';
s := 'A2:D ' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;
MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally := True;
MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1 ';
try
MyWorkBook.Saveas(FileName);
MyWorkBook.Close;
except
MyWorkBook.Close;
end;
ExcelApp.Quit;
ExcelApp := UnAssigned;
end;
end.
然后在调用它的单元里引用它就行了。
下面是调用它的代码:
procedure TForm1.Button1Click(Sender: TObject);
var
DataExcel: TDataSetToExcel;
saveDlg: TSaveDialog;
begin
saveDlg := TSaveDialog.Create(nil); //创建一个存储对话框
DataExcel := TDataSetToExcel.Create(nil);
try
saveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS ';
saveDlg.DefaultExt := 'XLS ';
saveDlg.FileName := NewString;
if saveDlg.Execute then
begin
DataExcel.DataSet := NewData; //连接的数据集
DataExcel.DataSet.DisableControls;
DataExcel.Transfer(saveDlg.FileName, NewString);
DataExcel.DataSet.EnableControls;
AlterMesg( '导出完毕 ', '提示信息 ');
end;
finally
saveDlg.Free;
DataExcel.Free;
end;
end;
===========================================================================
错误信息为
[Error] UnitDatatoExcel.pas(106): Undeclared identifier: 'UnAssigned '