Dbgrideh export execl

Procedure tform1.n1click (Sender: tobject); var gridtoexcel: tdbgridehtoexcel; begin try gridtoexcel: = tdbgridehtoexcel. create (NiL); gridtoexcel. dbgrideh: = dbgrideh1; // The Name Of The dbgrideh file whose data needs to be exported, gridtoexcel. titlename: = 'excel title'; // modify gridtoexcel as needed. showprogress: = true; gridtoexcel. showopenexcel: = true; gridtoexcel. exporttoexcel; finally gridtoexcel. free; end;

1. The above code is used in the form;

2. Save the following code as toexcel. PAS and reference it.

Unit toexcel; parameters, variants, classes, graphics, controls, forms, excel2000, comobj, dialogs, DB, dbgrideh, windows, comctrls, extctrls; Parameters = Class (tcomponent) Private fprogressform: tform; {progress form} ftempgauge: tprogressbar; {progress bar} fshowprogress: Boolean; {whether progress form is displayed} fshowopenexcel: Boolean; {whether to open the Excel file after export} fdbgrideh: tdbgrideh; ftitlename: tcaption; {Excel file title} fusername: Tcaption; {tabulation person} procedure setshowprogress (const value: Boolean); {display progress bar} procedure setshowopenexcel (const value: Boolean ); {open the generated Excel file} procedure setdbgrideh (const value: tdbgrideh); Procedure settitlename (const value: tcaption); {Title name} procedure setusername (const value: tcaption ); {user name} procedure createprocessform (aowner: tcomponent); {generate progress form} public constructor create (aowner: tcomponent ); Override; destructor destroy; override; Procedure exporttoexcel; {output Excel file} published property dbgrideh: writable read fdbgrideh write setdbgrideh; property showprogress: Boolean read fshowprogress write setshowprogress; // whether the progress bar property showopenexcel: Boolean read fshowopenexcel write setshowopenexcel; // whether to enable the Excel property titlename: tcaption read ftitlename write settitlename; property usern Ame: tcaption read fusername write setusername; end; implementationconstructor tdbgridehtoexcel. create (aowner: tcomponent); beginherited create (aowner); fshowprogress: = true; fshowopenexcel: = true; end; Procedure tdbgridehtoexcel. setshowprogress (const value: Boolean); beginfshowprogress: = value; end; Procedure tdbgridehtoexcel. setdbgrideh (const value: tdbgrideh); beginfdbgrideh: = value; end; Procedure TDB Gridehtoexcel. settitlename (const value: tcaption); beginftitlename: = value; end; Procedure tdbgridehtoexcel. setusername (const value: tcaption); beginfusername: = value; end; function isfileinuse (fname: string): Boolean; varhfileres: hfile; beginresult: = false; if not fileexists (fname) then exit; hfileres: = createfile (pchar (fname), generic_read or generic_write, 0, nil, open_existing, file_attribute_normal, 0 ); Result: = (hfileres = invalid_handle_value); if not result then closehandle (hfileres); end; Procedure tdbgridehtoexcel. exporttoexcel; varxlapp: variant; sheet: variant; S1, S2: string; caption, MSG: string; row, Col: integer; icount, jcount: integer; fbookmark: tbookmark; filename: string; savedialog1: tsavedialog; begin // exit if not dbgrideh if the dataset is empty or not open. datasource. dataset. active then exit; savedialog1: = tsaved Ialog. create (NiL); savedialog1.filename: = titlename + '_' + formatdatetime ('yyyy-MM-DD [hhmmss] ', now); savedialog1.filter: = 'excel file | *. XLS '; If savedialog1.execute then filename: = savedialog1.filename; savedialog1.free; If filename = ''then exit; while isfileinuse (filename) Do begin if application. messageBox ('The target file is in use. Please exit the target file and click OK to continue! ', 'Note', mb_okcancel + mb_iconwarning) = idok then begin end else begin exit; end; If fileexists (filename) then begin MSG: = 'existing file ('+ filename +'); overwrite? '; If application. messageBox (pchar (MSG), 'hs', mb_yesno + mb_iconquestion + mb_defbutton2) = idyes then begin // delete the file deletefile (pchar (filename) end else exit; end; application. processmessages; screen. cursor: = crhourglass; // display progress form if showprogress then createprocessform (NiL); if not varisempty (xlapp) then begin xlapp. displayalerts: = false; xlapp. quit; varclear (xlapp); end; // use OLE to create an Excel object try XL APP: = createoleobject ('excel. application'); cannot t messagedlg ('failed to create an Excel object. Please check if your system has correctly installed the Excel software! ', Mterror, [mbok], 0); screen. cursor: = crdefault; exit; end; // generate a work page xlapp. workbooks. add [xlwbatworksheet]; xlapp. workbooks [1]. worksheets [1]. name: = titlename; sheet: = xlapp. workbooks [1]. worksheets [titlename]; // write the title sheet. cells [1, 1]: = titlename; sheet. range [sheet. cells [1, 1], sheet. cells [1, dbgrideh. columns. count]. select; // select this column xlapp. selection. horizontalalignment: = $ ffffeff4; // center xlapp. selection. mergecells: = true; // merge // write the header row: = 1; jcount: = 3; for icount: = 0 to dbgrideh. columns. count-1 do begin Col: = 2; row: = icount + 1; caption: = dbgrideh. columns [icount]. title. caption; while pos ('|', caption)> 0 do begin jcount: = 4; S1: = copy (Caption, 1, pos ('|', caption) -1); If S2 = S1 then begin sheet. range [sheet. cells [col, row-1], sheet. cells [col, row]. select; xlapp. selection. horizontalalignment: = $ ffffeff4; xlapp. selection. mergecells: = true; end else sheet. cells [col, row]: = copy (Caption, 1, pos ('|', caption)-1); caption: = copy (Caption, pos ('| ', caption) + 1, length (Caption); Inc (COL); S2: = S1; end; sheet. cells [col, row]: = Caption; Inc (ROW); end; // merge the header and center it if jcount = 4 then for icount: = 1 to dbgrideh. columns. count do if sheet. cells [3, icount]. value = ''then begin sheet. range [sheet. cells [2, icount], sheet. cells [3, icount]. select; xlapp. selection. horizontalalignment: = $ ffffeff4; xlapp. selection. mergecells: = true; end else begin sheet. cells [3, icount]. select; xlapp. selection. horizontalalignment: = $ ffffeff4; end; // read data dbgrideh. datasource. dataset. disablecontrols; fbookmark: = dbgrideh. datasource. dataset. getbookmark; dbgrideh. datasource. dataset. first; while not dbgrideh. datasource. dataset. EOF do begin for icount: = 1 to dbgrideh. columns. count do begin // sheet. cells [jcount, icount]: = dbgrideh. columns. it [iCount-1]. field. asstring; Case dbgrideh. datasource. dataset. fieldbyname (dbgrideh. columns. it [iCount-1]. fieldname ). datatype of ftsmallint, ftinteger, ftword, ftautoinc, ftbytes: sheet. cells [jcount, icount]: = dbgrideh. columns. it [iCount-1]. field. asinteger; ftfloat, ftcurrency, ftbcd: sheet. cells [jcount, icount]: = dbgrideh. columns. it [iCount-1]. field. asfloat; else if dbgrideh. datasource. dataset. fieldbyname (dbgrideh. columns. it [iCount-1]. fieldname) is tblobfield then // This type of field (image, etc.) cannot read the display sheet. cells [jcount, icount]: = dbgrideh. columns. it [iCount-1]. field. asstring else sheet. cells [jcount, icount]: = ''' + dbgrideh. columns. it [iCount-1]. field. asstring; end; Inc (jcount); // displays the progress bar if showprogress then begin ftempgauge. position: = dbgrideh. datasource. dataset. recno; ftempgauge. refresh; end; dbgrideh. datasource. dataset. next; end; If dbgrideh. datasource. dataset. bookmarkvalid (fbookmark) Then dbgrideh. datasource. dataset. gotobookmark (fbookmark); dbgrideh. datasource. dataset. enablecontrols; // read the table Script If dbgrideh. footerrowcount> 0 then begin for row: = 0 to dbgrideh. footerRowCount-1 do begin for col: = 0 to dbgrideh. columns. count-1 do sheet. cells [jcount, Col + 1]: = dbgrideh. getfootervalue (row, dbgrideh. columns [col]); Inc (jcount); end; // adjust the column width // For icount: = 1 to dbgrideh. columns. count do // sheet. columns [icount]. entirecolumn. autofit; sheet. cells [1, 1]. select; xlapp. workbooks [1]. saveas (filename); xlapp. visible: = true; xlapp: = unassigned; If showprogress then freeandnil (fprogressform); screen. cursor: = crdefault; end; destructor tdbgridehtoexcel. destroy; beginherited destroy; end; Procedure tdbgridehtoexcel. createprocessform (aowner: tcomponent); varpanel: tpanel; beginif assigned (fprogressform) Then exit; fprogressform: = tform. create (aowner); with fprogressform dobegin try font. name: = ''; {Set Font} font. size: = 10; borderstyle: = bsnone; width: = 300; Height: = 30; borderwidth: = 1; color: = clblack; position: = poscreencenter; Panel: = tpanel. create (fprogressform); with panel do begin parent: = fprogressform; align: = alclient; caption: = 'exporting excel. Please wait ...... '; color: = $00e9e5e0; end; ftempgauge: = tprogressbar. create (panel); with ftempgauge do begin parent: = Panel; align: = alclient; min: = 0; max: = dbgrideh. datasource. dataset. recordcount; position: = 0; end; begin t end; fprogressform. show; fprogressform. update; end; Procedure tdbgridehtoexcel. setshowopenexcel (const value: Boolean); begin fshowopenexcel: = value; end.