DBGRIDEH导出EXECL

procedure TForm1.N1Click(Sender: TObject);
varGridtoExcel: TDBGridEhToExcel;
begintryGridtoExcel :&＃61; TDBGridEhToExcel.Create(nil);GridtoExcel.DBGridEh :&＃61; DBGridEh1; //需要导出数据的DBGridEh文件名GridtoExcel.TitleName :&＃61; &＃39;EXCEL的标题&＃39;; //根据需要自行修改GridtoExcel.ShowProgress :&＃61; true;GridtoExcel.ShowOpenExcel :&＃61; true;GridtoExcel.ExportToExcel;finallyGridtoExcel.Free;end;
end;


unit ToExcel;interface
uses
SysUtils, Variants, Classes, Graphics, Controls, Forms, Excel2000, ComObj,
Dialogs, DB, DBGridEh, windows,ComCtrls,ExtCtrls;typeTDBGridEhToExcel &＃61; class(TComponent)
privateFProgressForm: TForm; {进度窗体}FtempGauge: TProgressBar; {进度条}FShowProgress: Boolean; {是否显示进度窗体}FShowOpenExcel:Boolean; {是否导出后打开Excel文件}FDBGridEh: TDBGridEh;FTitleName: TCaption; {Excel文件标题}FUserName: TCaption; {制表人}procedure SetShowProgress(const Value: Boolean); {是否显示进度条}procedure SetShowOpenExcel(const Value: Boolean); {是否打开生成的Excel文件}procedure SetDBGridEh(const Value: TDBGridEh);procedure SetTitleName(const Value: TCaption); {标题名称}procedure SetUserName(const Value: TCaption); {使用人名称}procedure CreateProcessForm(AOwner: TComponent); {生成进度窗体}
publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;procedure ExportToExcel; {输出Excel文件}
publishedproperty DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;property ShowProgress: Boolean read FShowProgress write SetShowProgress; //是否显示进度条property ShowOpenExcel: Boolean read FShowOpenExcel write SetShowOpenExcel; //是否打开Excelproperty TitleName: TCaption read FTitleName write SetTitleName;property UserName: TCaption read FUserName write SetUserName;
end;implementationconstructor TDBGridEhToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShowProgress :&＃61; True;
FShowOpenExcel:&＃61; True;
end;procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean);
begin
FShowProgress :&＃61; Value;
end;procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh);
begin
FDBGridEh :&＃61; Value;
end;procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption);
begin
FTitleName :&＃61; Value;
end;procedure TDBGridEhToExcel.SetUserName(const Value: TCaption);
begin
FUserName :&＃61; Value;
end;function IsFileInUse(fName: string ): boolean;
var
HFileRes: HFILE;
begin
Result :&＃61;false;
if not FileExists(fName) then exit;
HFileRes :&＃61;CreateFile(pchar(fName), GENERIC_READor GENERIC_WRITE,0, nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
Result :&＃61;(HFileRes&＃61;INVALID_HANDLE_VALUE);
if not Result thenCloseHandle(HFileRes);
end;procedure TDBGridEhToExcel.ExportToExcel;
var
XLApp: Variant;
Sheet: Variant;
s1, s2: string;
Caption,Msg: String;
Row, Col: integer;
iCount, jCount: Integer;
FBookMark: TBookmark;
FileName: String;
SaveDialog1: TSaveDialog;
begin//如果数据集为空或没有打开则退出if not DBGridEh.DataSource.DataSet.Active then Exit;SaveDialog1 :&＃61; TSaveDialog.Create(Nil);SaveDialog1.FileName :&＃61;TitleName &＃43; &＃39;_&＃39; &＃43; FormatDateTime(&＃39;YYYY-MM-DD[HHMMSS]&＃39;, now);SaveDialog1.Filter :&＃61; &＃39;Excel文件|*.xls&＃39;;if SaveDialog1.Execute thenFileName :&＃61; SaveDialog1.FileName;SaveDialog1.Free;if FileName &＃61; &＃39;&＃39; then Exit;while IsFileInUse(FileName) dobeginif Application.MessageBox(&＃39;目标文件使用中&＃xff0c;请退出目标文件后点击确定继续&＃xff01;&＃39;, &＃39;注意&＃39;, MB_OKCANCEL &＃43; MB_ICONWARNING) &＃61; IDOK thenbeginendelsebeginExit;end; end;if FileExists(FileName) thenbeginMsg :&＃61; &＃39;已存在文件&＃xff08;&＃39; &＃43; FileName &＃43; &＃39;&＃xff09;&＃xff0c;是否覆盖&＃xff1f;&＃39;;if Application.MessageBox(PChar(Msg), &＃39;提示&＃39;, MB_YESNO &＃43; MB_ICONQUESTION &＃43; MB_DEFBUTTON2) &＃61; IDYES thenbegin//删除文件DeleteFile(PChar(FileName))endelseexit;end;Application.ProcessMessages;Screen.Cursor :&＃61; crHourGlass;//显示进度窗体if ShowProgress thenCreateProcessForm(nil);if not VarIsEmpty(XLApp) thenbeginXLApp.DisplayAlerts :&＃61; False;XLApp.Quit;VarClear(XLApp);end;//通过ole创建Excel对象tryXLApp :&＃61; CreateOleObject(&＃39;Excel.Application&＃39;);exceptMessageDlg(&＃39;创建Excel对象失败&＃xff0c;请检查你的系统是否正确安装了Excel软件&＃xff01;&＃39;, mtError, [mbOk], 0);Screen.Cursor :&＃61; crDefault;Exit;end;//生成工作页XLApp.WorkBooks.Add[XLWBatWorksheet];XLApp.WorkBooks[1].WorkSheets[1].Name :&＃61; TitleName;Sheet :&＃61; XLApp.Workbooks[1].WorkSheets[TitleName];//写标题sheet.cells[1, 1] :&＃61; TitleName;sheet.range[sheet.cells[1, 1], sheet.cells[1, DBGridEh.Columns.Count]].Select; //选择该列XLApp.selection.HorizontalAlignment :&＃61; $FFFFEFF4; //居中XLApp.selection.MergeCells :&＃61; True; //合并//写表头Row :&＃61; 1;jCount :&＃61; 3;for iCount :&＃61; 0 to DBGridEh.Columns.Count - 1 dobeginCol :&＃61; 2;Row :&＃61; iCount&＃43;1;Caption :&＃61; DBGridEh.Columns[iCount].Title.Caption;while POS(&＃39;|&＃39;, Caption) > 0 dobeginjCount :&＃61; 4;s1 :&＃61; Copy(Caption, 1, Pos(&＃39;|&＃39;,Caption)-1);if s2 &＃61; s1 thenbeginsheet.range[sheet.cells[Col, Row-1],sheet.cells[Col, Row]].Select;XLApp.selection.HorizontalAlignment :&＃61; $FFFFEFF4;XLApp.selection.MergeCells :&＃61; True;endelseSheet.cells[Col,Row] :&＃61; Copy(Caption, 1, Pos(&＃39;|&＃39;,Caption)-1);Caption :&＃61; Copy(Caption,Pos(&＃39;|&＃39;, Caption)&＃43;1, Length(Caption));Inc(Col);s2 :&＃61; s1;end;Sheet.cells[Col, Row] :&＃61; Caption;Inc(Row);end;//合并表头并居中if jCount &＃61; 4 thenfor iCount :&＃61; 1 to DBGridEh.Columns.Count doif Sheet.cells[3, iCount].Value &＃61; &＃39;&＃39; thenbeginsheet.range[sheet.cells[2, iCount],sheet.cells[3, iCount]].Select;XLApp.selection.HorizontalAlignment :&＃61; $FFFFEFF4;XLApp.selection.MergeCells :&＃61; True;endelse beginsheet.cells[3, iCount].Select;XLApp.selection.HorizontalAlignment :&＃61; $FFFFEFF4;end;//读取数据DBGridEh.DataSource.DataSet.DisableControls;FBookMark :&＃61; DBGridEh.DataSource.DataSet.GetBookmark;DBGridEh.DataSource.DataSet.First;while not DBGridEh.DataSource.DataSet.Eof dobeginfor iCount :&＃61; 1 to DBGridEh.Columns.Count dobegin//Sheet.cells[jCount, iCount] :&＃61;DBGridEh.Columns.Items[iCount-1].Field.AsString;case DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[iCount-1].FieldName).DataType offtSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:Sheet.cells[jCount, iCount] :&＃61;DBGridEh.Columns.Items[iCount-1].Field.asinteger;ftFloat, ftCurrency, ftBCD:Sheet.cells[jCount, iCount] :&＃61;DBGridEh.Columns.Items[iCount-1].Field.AsFloat;elseif DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[iCount-1].FieldName) is TBlobfield then // 此类型的字段(图像等)暂无法读取显示Sheet.cells[jCount, iCount] :&＃61;DBGridEh.Columns.Items[iCount-1].Field.AsStringelseSheet.cells[jCount, iCount] :&＃61;&＃39;&＃39;&＃39;&＃39;&＃43;DBGridEh.Columns.Items[iCount-1].Field.AsString;end;end;Inc(jCount);//显示进度条进度过程if ShowProgress thenbeginFtempGauge.Position :&＃61; DBGridEh.DataSource.DataSet.RecNo;FtempGauge.Refresh;end;DBGridEh.DataSource.DataSet.Next;end;if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) thenDBGridEh.DataSource.DataSet.GotoBookmark(FBookMark);DBGridEh.DataSource.DataSet.EnableControls;//读取表脚if DBGridEh.FooterRowCount > 0 thenbeginfor Row :&＃61; 0 to DBGridEh.FooterRowCount-1 dobeginfor Col :&＃61; 0 to DBGridEh.Columns.Count-1 doSheet.cells[jCount, Col&＃43;1] :&＃61; DBGridEh.GetFooterValue(Row,DBGridEh.Columns[Col]);Inc(jCount);end;end;//调整列宽
// for iCount :&＃61; 1 to DBGridEh.Columns.Count do
// Sheet.Columns[iCount].EntireColumn.AutoFit;sheet.cells[1, 1].Select;XlApp.Workbooks[1].SaveAs(FileName);XlApp.Visible :&＃61; True;XlApp :&＃61; Unassigned;if ShowProgress thenFreeAndNil(FProgressForm);Screen.Cursor :&＃61; crDefault;end;destructor TDBGridEhToExcel.Destroy;
begin
inherited Destroy;
end;procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);
var
Panel: TPanel;
begin
if Assigned(FProgressForm) thenexit;FProgressForm :&＃61; TForm.Create(AOwner);
with FProgressForm do
begintryFont.Name :&＃61; &＃39;宋体&＃39;; {设置字体}Font.Size :&＃61; 10;BorderStyle :&＃61; bsNone;Width :&＃61; 300;Height :&＃61; 30;BorderWidth :&＃61; 1;Color :&＃61; clBlack;Position :&＃61; poScreenCenter;Panel :&＃61; TPanel.Create(FProgressForm);with Panel dobeginParent :&＃61; FProgressForm;Align :&＃61; alClient;Caption :&＃61; &＃39;正在导出Excel&＃xff0c;请稍候......&＃39;;Color:&＃61;$00E9E5E0;end;FtempGauge:&＃61;TProgressBar.Create(Panel);with FtempGauge dobeginParent :&＃61; Panel;Align:&＃61;alClient;Min :&＃61; 0;Max:&＃61; DBGridEh.DataSource.DataSet.RecordCount;Position :&＃61; 0;end;exceptend;
end;
FProgressForm.Show;
FProgressForm.Update;
end;procedure TDBGridEhToExcel.SetShowOpenExcel(const Value: Boolean);
beginFShowOpenExcel:&＃61;Value;
end;end.