导出DBGrid文件到Excel

            既然大家都在这里将自己的东西贴出来，那我就再贴一个，将DBGrid中的文件转换到Excel中或者转换到Txt中的控件。
            我自己编写的，希望大家讨论一下。
            unit DBGridExport;
            interface
            uses
            SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
            StdCtrls, Db, DBGrids, Comobj, extctrls, comctrls, ActiveX;
            type
            TSpaceMark = (csComma, csSemicolon, csTab, csBlank, csEnter);
            TDBGridExport = class(TComponent)
            private
            FDB_Grid: TDBGrid; {读取DBGrid的源}
            FTxtFileName: string; {文本文件名}
            FSpaceMark: TSpaceMark; {间隔符号}
            FSpace_Ord: Integer; {间隔符号的Asc数值}
            FTitle: string; {显示的标题}
            FSheetName: string; {工作表标题}
            FExcel_Handle: OleVariant; {Excel的句柄}
            FWorkbook_Handle: OleVariant; {书签的句柄}
            FShow_Progress: Boolean; {是否显示插入进度}
            FProgress_Form: TForm; {进度窗体}
            FRun_Excel_Form: TForm; {启动Excel提示窗口}
            FProgressBar: TProgressBar; {进度条}
            function Connect_Excel: Boolean; {启动Excel}
            function New_Workbook: Boolean; {插入新的工作博}
            function InsertData_To_Excel: Boolean; {插入数据}
            procedure Create_ProgressForm(AOwner: TComponent); {创建进度显示窗口}
            procedure Create_Run_Excel_Form(AOwner: TComponent); {创建启动Excel窗口}
            procedure SetSpaceMark(Value: TSpaceMark); {设置导出时的间隔符号}
            protected
            public
            constructor Create(AOwner: TComponent); override; {新建}
            destructor Destroy; override; {销毁}
            function Export_To_Excel: Boolean; overload; {导出到Excel中}
            function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload;
            function Export_To_Txt(NewFile: Boolean = True): Boolean;             overload; {导出到文本文件中}
            function Export_To_Txt(FileName: string; NewFile: Boolean =             True): Boolean; overload;
            function Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean =             True): Boolean; overload;
            function Export_To_Txt(FileName: string; DB_Grid: TDBGrid;             NewFile: Boolean = True): Boolean; overload;
            published
            property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid;
            property Show_Progress: Boolean read FShow_Progress write             FShow_Progress;
            property TxtFileName: string read FTxtFileName write FTxtFileName;
            property SpaceMark: TSpaceMark read FSpaceMark write SetSpaceMark;
            property Title: string read FTitle write FTitle;
            property SheetName: string read FSheetName write FSheetName;
            end;
            procedure Register;
            implementation
            procedure Register;
            begin
            RegisterComponents('Stone', [TDBGridExport]);
            end;
            {-------------------------------------------------------------------------------}
            {新建}
            constructor TDBGridExport.Create(AOwner: TComponent);
            begin
            inherited Create(AOwner);
            FShow_Progress := True;
            FSpaceMark := csTab;
            end;
            {销毁}
            destructor TDBGridExport.Destroy;
            begin
            varClear(FExcel_Handle);
            varClear(FWorkbook_Handle);
            inherited Destroy;
            end;
            {===============================================================================}
            {导出到文本文件中}
            function TDBGridExport.Export_To_Txt(NewFile: Boolean = True):             Boolean;
            var
            Txt: TStrings;
            Tmp_Str: string;
            data_Str: string;
            i, j: Integer;
            Column_name: string;
            Data_Set: TDataSet;
            bookmark: pointer;
            Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
            begin
            Result := False;
            if NewFile = True then
            FTxtFileName := '';
            if FTxtFileName = '' then
            begin
            with TSaveDialog.Create(nil) do
            begin
            Title := '请选择输出文件名';
            DefaultExt := 'txt';
            Filter := '文本文件(*.Txt)|*.txt';
            Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist,             ofNoReadOnlyReturn, ofEnableSizing];
            if Execute then
            FTxtFileName := FileName;
            Free;
            if FTxtFileName = '' then {如果没有选中文件，则直接推出}
            exit;
            end;
            if FTxtFileName = '' then
            begin
            raise exception.Create('没有指定输出文件');
            Exit;
            end;
            end;
            if FDB_Grid = nil then
            raise exception.Create('请输入DBGrid名称');
            Txt := TStringList.Create;
            try
            {显示插入进度}
            if FShow_Progress = True then
            begin
            Create_ProgressForm(nil);
            FProgress_Form.Show;
            end;
            {第一行，插入标题}
            Tmp_Str := ''; //FDB_Grid.Columns[0].Title.Caption;
            for i := 1 to FDB_Grid.Columns.Count do
            if FDB_Grid.Columns[i - 1].Visible = True then
            Tmp_Str := Tmp_Str + FDB_Grid.Columns[i - 1].Title.Caption +             Chr(FSpace_Ord);
            Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
            Txt.Add(Tmp_Str);
            {插入DBGrid中的数据}
            Data_Set := FDB_Grid.DataSource.DataSet;
            {记忆当前位置并取消任何事件}
            // new(bookmark);
            bookmark := Data_Set.GetBookmark;
            Data_Set.DisableControls;
            Before_Scroll := Data_Set.BeforeScroll;
            Afrer_Scroll := Data_Set.AfterScroll;
            Data_Set.BeforeScroll := nil;
            Data_Set.AfterScroll := nil;
            if FShow_Progress = True then
            begin
            Data_Set.Last;
            FProgress_Form.Refresh;
            FProgressBar.Max := Data_Set.RecordCount;
            end;
            {插入DBGrid中的所有字段}
            Data_Set.First;
            j := 2;
            while not Data_Set.Eof do
            begin
            if FShow_Progress = True then
            FProgressBar.Position := j - 2;
            Column_name := FDB_Grid.Columns[0].FieldName;
            Tmp_Str := ''; //Data_Set.FieldByName(Column_name).AsString;
            for i := 1 to FDB_Grid.Columns.Count do
            if FDB_Grid.Columns[i - 1].Visible = True then
            begin
            data_Str := FDB_Grid.Fields[i - 1].DisplayText;
            Tmp_Str := Tmp_Str + data_Str + Chr(FSpace_Ord);
            end;
            Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
            Txt.Add(Tmp_Str);
            j := j + 1;
            Data_Set.Next;
            end;
            {恢复原始事件以及标志位置}
            Data_Set.GotoBookmark(bookmark);
            Data_Set.FreeBookmark(bookmark);
            // dispose(bookmark);
            Data_Set.EnableControls;
            Data_Set.BeforeScroll := Before_Scroll;
            Data_Set.AfterScroll := Afrer_Scroll;
            {写到文件}
            Txt.SaveToFile(FTxtFileName);
            Result := True;
            finally
            Txt.Free;
            if FShow_Progress = True then
            begin
            FProgress_Form.Free;
            FProgress_Form := nil;
            end;
            end;
            end;
            function TDBGridExport.Export_To_Txt(FileName: string; NewFile:             Boolean = True): Boolean;
            begin
            FTxtFileName := FileName;
            Result := Export_To_Txt(NewFile);
            end;
            function TDBGridExport.Export_To_Txt(DB_Grid: TDBGrid; NewFile:             Boolean = True): Boolean;
            begin
            FDB_Grid := DB_Grid;
            Result := Export_To_Txt(NewFile);
            end;
            function TDBGridExport.Export_To_Txt(FileName: string; DB_Grid:             TDBGrid; NewFile: Boolean = True): Boolean;
            begin
            FTxtFileName := FileName;
            FDB_Grid := DB_Grid;
            Result := Export_To_Txt(NewFile);
            end;
            {-------------------------------------------------------------------------------}
            {设置导出时的间隔符号}
            procedure TDBGridExport.SetSpaceMark(Value: TSpaceMark);
            begin
            FSpaceMark := Value;
            case Value of
            csComma: FSpace_Ord := ord(',');
            csSemicolon: FSpace_Ord := ord(';');
            csTab: FSpace_Ord := 9;
            csBlank: FSpace_Ord := 32;
            csEnter: FSpace_Ord := 13;
            end;
            end;
            　
            {===============================================================================}
            {导出到Excel中}
            function TDBGridExport.Export_To_Excel: Boolean;
            begin
            if FDB_Grid = nil then
            raise exception.Create('请输入DBGrid名称');
            Result := False;
            if Connect_Excel = True then
            if New_Workbook = True then
            if InsertData_To_Excel = True then
            Result := True;
            end;
            function TDBGridExport.Export_To_Excel(DB_Grid: TDBGrid):             Boolean;
            begin
            FDB_Grid := DB_Grid;
            Result := Export_To_Excel;
            end;
            　
            {-------------------------------------------------------------------------------}
            {启动Excel}
            function TDBGridExport.Connect_Excel: Boolean;
            {连接Ole对象}
            function My_GetActiveOleObject(const ClassName: string; out             Ole_Handle: IDispatch): Boolean;
            var //IDispatch
            ClassID: TCLSID;
            Unknown: IUnknown;
            l_Result: HResult;
            begin
            Result := False;
            l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)),             ClassID);
            if (l_Result and $80000000) = 0 then
            begin
            l_Result := GetActiveObject(ClassID, nil, Unknown);
            if (l_Result and $80000000) = 0 then
            begin
            l_Result := Unknown.QueryInterface(IDispatch, Ole_Handle);
            if (l_Result and $80000000) = 0 then
            Result := True;
            end;
            end;
            end;
            {创建OLE对象}
            function My_CreateOleObject(const ClassName: string; out             Ole_Handle: IDispatch): Boolean;
            var
            ClassID: TCLSID;
            l_Result: HResult;
            begin
            Result := False;
            l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)),             ClassID);
            if (l_Result and $80000000) = 0 then
            begin
            l_Result := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER             or
            CLSCTX_LOCAL_SERVER, IDispatch, Ole_Handle);
            if (l_Result and $80000000) = 0 then
            Result := True;
            end;
            end;
            var
            l_Excel_Handle: IDispatch;
            begin
            if FShow_Progress = True then
            begin
            Create_Run_Excel_Form(nil);
            FRun_Excel_Form.Show;
            end;
            if My_GetActiveOleObject('Excel.Application', l_Excel_Handle) =             False then
            if My_CreateOleObject('Excel.Application', l_Excel_Handle) =             False then
            begin
            FRun_Excel_Form.Free;
            FRun_Excel_Form := nil;
            raise exception.Create('启动Excel失败，可能没有安装Excel！');
            Result := False;
            Exit;
            end;
            FExcel_Handle := l_Excel_Handle;
            if FShow_Progress = True then
            begin
            FRun_Excel_Form.Free;
            FRun_Excel_Form := nil;
            end;
            Result := True;
            end;
            {插入新的工作博}
            function TDBGridExport.New_Workbook: Boolean;
            var
            i: Integer;
            begin
            Result := True;
            try
            FWorkbook_Handle := FExcel_Handle.Workbooks.Add;
            except
            raise exception.Create('新建Excel工作表出错！');
            Result := False;
            Exit;
            end;
            if FTitle <> '' then
            FWorkbook_Handle.Application.ActiveWindow.Caption := FTitle;
            if FSheetName <> '' then
            begin
            for i := 2 to FWorkbook_Handle.Sheets.Count do
            if FSheetName = FWorkbook_Handle.Sheets[i].Name then
            begin
            raise exception.Create('工作表命名重复！');
            Result := False;
            exit;
            end;
            try
            FWorkbook_Handle.Sheets[1].Name := FSheetName;
            except
            raise exception.Create('工作表命名错误！');
            Result := False;
            exit;
            end;
            end;
            end;
            {插入数据}
            function TDBGridExport.InsertData_To_Excel: Boolean;
            var
            i, j, k: Integer;
            data_Str: string;
            Column_name: string;
            Data_Set: TDataSet;
            bookmark: pointer;
            Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
            begin
            try
            {显示插入进度}
            if FShow_Progress = True then
            begin
            Create_ProgressForm(nil);
            FProgress_Form.Show;
            end;
            {第一行，插入标题}{仅仅插入可见数据}
            j := 1;
            for i := 1 to FDB_Grid.Columns.Count do
            if FDB_Grid.Columns[i - 1].Visible = True then
            begin
            FWorkbook_Handle.WorkSheets[1].Cells[1, j].Value :=             FDB_Grid.Columns[i - 1].Title.Caption;
            FWorkbook_Handle.WorkSheets[1].Columns[j].ColumnWidth :=             FDB_Grid.Columns[i - 1].Width div 6;
            j := j + 1
            end;
            {插入DBGrid中的数据}
            Data_Set := FDB_Grid.DataSource.DataSet;
            {记忆当前位置并取消任何事件}
            // new(bookmark);
            bookmark := Data_Set.GetBookmark;
            Data_Set.DisableControls;
            Before_Scroll := Data_Set.BeforeScroll;
            Afrer_Scroll := Data_Set.AfterScroll;
            Data_Set.BeforeScroll := nil;
            Data_Set.AfterScroll := nil;
            if FShow_Progress = True then
            begin
            Data_Set.Last;
            FProgress_Form.Refresh;
            FProgressBar.Max := Data_Set.RecordCount;
            end;
            Data_Set.First;
            k := 2;
            while not Data_Set.Eof do
            begin
            if FShow_Progress = True then
            FProgressBar.Position := k;
            j := 1;
            for i := 1 to FDB_Grid.Columns.Count do
            begin
            if FDB_Grid.Columns[i - 1].Visible = True then
            begin
            Column_name := FDB_Grid.Columns[i - 1].FieldName;
            data_Str := FDB_Grid.Fields[i - 1].DisplayText;
            FWorkbook_Handle.WorkSheets[1].Cells[k, j].Value := data_Str;
            j := j + 1;
            end;
            end;
            k := k + 1;
            Data_Set.Next;
            end;
            {恢复原始事件以及标志位置}
            Data_Set.GotoBookmark(bookmark);
            Data_Set.FreeBookmark(bookmark);
            // dispose(bookmark);
            Data_Set.EnableControls;
            Data_Set.BeforeScroll := Before_Scroll;
            Data_Set.AfterScroll := Afrer_Scroll;
            Result := True;
            finally
            FExcel_Handle.Visible := True;
            FExcel_Handle.Application.ScreenUpdating := True;
            if FShow_Progress = True then
            begin
            FProgress_Form.Free;
            FProgress_Form := nil;
            end;
            end;
            end;
            {===============================================================================}
            {启动Excel时给出进度显示}
            procedure TDBGridExport.Create_Run_Excel_Form(AOwner:             TComponent);
            var
            Panel: TPanel;
            Prompt: TLabel; {提示的标签}
            begin
            if assigned(FRun_Excel_Form) then exit;
            FRun_Excel_Form := TForm.Create(AOwner);
            with FRun_Excel_Form do
            begin
            try
            Font.Name := '宋体'; {设置字体}
            Font.Size := 9;
            BorderStyle := bsNone;
            Width := 300;
            Height := 100;
            BorderWidth := 2;
            Color := clBlue;
            Position := poScreenCenter;
            Panel := TPanel.Create(FRun_Excel_Form);
            with Panel do
            begin
            Parent := FRun_Excel_Form;
            Align := alClient;
            BevelInner := bvNone;
            BevelOuter := bvRaised;
            Caption := '';
            end;
            Prompt := TLabel.Create(Panel);
            with Prompt do
            begin
            Parent := panel;
            AutoSize := True;
            Left := 25;
            Top := 25;
            Caption := '正在导出数据，请稍候……';
            end;
            except
            end;
            end;
            end;
            　
            {===============================================================================}
            {创建进度显示窗口}
            procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent);
            var
            Panel: TPanel;
            Prompt: TLabel; {提示的标签}
            begin
            if assigned(FProgress_Form) then exit;
            FProgress_Form := TForm.Create(AOwner);
            with FProgress_Form do
            begin
            try
            Font.Name := '宋体'; {设置字体}
            Font.Size := 9;
            BorderStyle := bsNone;
            Width := 300;
            Height := 100;
            BorderWidth := 2;
            Color := clBlue;
            Position := poScreenCenter;
            Panel := TPanel.Create(FProgress_Form);
            with Panel do
            begin
            Parent := FProgress_Form;
            Align := alClient;
            BevelInner := bvNone;
            BevelOuter := bvRaised;
            Caption := '';
            end;
            Prompt := TLabel.Create(Panel);
            with Prompt do
            begin
            Parent := panel;
            AutoSize := True;
            Left := 25;
            Top := 25;
            Caption := '正在导出数据，请稍候……';
            end;
            FProgressBar := TProgressBar.Create(panel);
            with FProgressBar do
            begin
            Parent := panel;
            Left := 20;
            Top := 50;
            Height := 18;
            Width := 260;
            end;
            except
            end;
            end;
            end;
            　
            end.