Preface:
In the actual production of software, in order to save development costs and development cycles, some software personnel usually export directly in DBGRID to the Excel table, and the previously seen function can only import data in one sheet of Workbook, Do not support more Sheet! .
Unit application:
Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, DB, DBTables, Grids, DBGRIDS, ActiveX, Comobj, Excel2000, Oleserver;
test environment:
OS: Win2k Pro; Excel2k; Delphi6.0
Source program:
{Function Description: Output DBGRID to Excel Table (Support Multi Sheet) Design: Coolslob Date: 2002-10-23 Support: Coolslob@163.com Call Format: CopyDbDataToExcel ([DBGRID1, DBGRID2]);} Procedure CopyDbDataToExcel (Args: array of const); var iCount, jCount: Integer; xLApp: Variant; Sheet: Variant; I: Integer; begin Screen.Cursor: = crHourGlass; if not VarIsEmpty (xLApp) then begin XLApp.DisplayAlerts: = False; xLApp.Quit VARCLEAR (XLAP); END;
Try xlapp: = createoleObject ('Excel.Application'); Except Screen.cursor: = Crdefault; EXIT;
XLapp.Workbooks.Add; xlapp.sheetsinnewwbook: = high (args) 1;
For i: = low (args) to high (args) do begin xlapp.workbooks [1] .worksheets [i 1] .name: = tdbgrid (args [i] .vobject) .Name; Sheet: = xlapp.workbooks [1] .Worksheets [TDBGRID (args [i] .vobject) .name]; if not tdbGrid (args [i] .vobject) .DataSource.DataSet.active dam screen.cursor: = crdefault;
TDBGRID (args [i] .vobject) .datasource.DataSet.first; for iCount: = 0 to tdbgrid (args [i] .vobject) .COLUMNS.COUNT - 1 Do Sheet.cells [1, ICOUNT 1]: = TDBGRID (args [i] .vobject) .Columns.Items [iCount] .title.caption; jcount: = 1; while not tdbgrid (args [i] .vobject) .datasource.DataSet.eof do begin for iCount: = 0 To TdbGrid (Args [i] .vobject) .Columns.count - 1 do sheet.cells [jcount 1, iCount 1]: = TDBGRID (args [i] .vobject) .columns.Items [iCount] .field. Asstring; inc (jcount); tdbgrid (args [i] .vobject) .datasource.DataSet.next; end; end; xlapp.visible: = true; screen.cursor: = crdefault; END;
