delphi 2010 ocx excel

FExcelApp:= unassigned; 解决进程关闭问题
2009-11-09 11:32

使用 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 '

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值