Delphi generates multiple sheet Excel files

Delphi generates multiple sheet Excel filesCode.

 

----------------------------------------

 

Uses comobj;

// Generate the Excel table header information. // By jrq 20091205
Procedure createxceltitle (exlapp: olevariant; sheetname: string );
VaR range: olevariant;
Begin
Exlapp. cells [1, 1]. Value: = 'sequence number '; // The first row of column 1st
Exlapp. cells [1, 2]. Value: = 'file No. '; // The first row of Column 2nd
Exlapp. cells [1, 3]. Value: = 'title ';
Exlapp. cells [1, 4]. Value: = 'start date ';
Exlapp. cells [1, 5]. Value: = 'end date ';
Exlapp. cells [1, 6]. Value: = 'retention time ';
Exlapp. cells [1, 7]. Value: = 'confidentiality level ';

Range: = exlapp. worksheets [sheetname]. Range ['a1: g1']; // range from A2 to M2. merge; // merge Cells
Range. Rows. rowheight: = 25; // you can specify the Row Height.
Range. horizontalalignment: = 3; // Horizontal Alignment

Range. Columns [1]. columnwidth: = 6; // serial number
Range. Columns [2]. columnwidth: = 20; // file number
Range. Columns [3]. columnwidth: = 60; // Title
Range. Columns [4]. columnwidth: = 12; // start date
Range. Columns [5]. columnwidth: = 12; // end date
Range. Columns [6]. columnwidth: = 8; // retention period
Range. Columns [7]. columnwidth: = 8; // confidentiality level
End;

// Save the dataset to an Excel file. By jrq 20091205
Function savetoexcel (afilename: string; anum: string; aqry: tadoquery): Boolean;
VaR
Isexist: Boolean;
Row, I: integer;
Excelapp, workbook, Worksheet: olevariant;
Sheetname, tmpsheetname: string;
Begin
Result: = false;
Isexist: = false;

// Determine whether an Excel file exists on the disk.
If fileexists (afilename) then
Isexist: = true;

Sheetname: = 'data directory' + anum; // the I-th sheet.

Try
Excelapp: = createoleobject ('excel. application'); // first create an Excel Object and use comobj:

If isexist then
Excelapp. workbooks. Open (afilename) // open an existing workbook
Else
Workbook: = excelapp. workbooks. Add; // Add a workbook.

For I: = 1 to excelapp. worksheets. Count do
Begin
Tmpsheetname: = excelapp. worksheets [I]. Name;

// Delete a sheet with the same name.
If tmpsheetname = sheetname then
Begin
// Excelapp. worksheets [sheetname]. Activate; // sets an active sheet.
// Excelapp. worksheets [sheetname]. Delete; // Delete

Showmessage ('+ sheetname +' "already exists. Please check and confirm! ');
Excelapp. activeworkbook. Saved: = true; // discard the Save
Excelapp. workbooks. Close; // close the workbook:

If not varisempty (excelapp) then
Excelapp. Quit;

Result: = false;
Exit;
End;
End;

Worksheet: = excelapp. worksheets. Add; // create a new sheet
Excelapp. Visible: = false;
Worksheet. Name: = sheetname; // Sheet Name
Excelapp. worksheets [sheetname]. Activate;
Except
Showmessage ('an exception occurred while creating the EXCEL object. An error occurred while generating the Excel file. Check whether Microsoft Office Excel is installed on your computer.Program! ');
Excelapp. Quit;
Exit;
End;

Createxceltitle (excelapp, sheetname );
Row: = 1;

Try
Aqry. first;
While not aqry. EOF do
Begin
// Write an Excel file
Row: = row + 1;
Worksheet. cells [row, 1]. Value: = inttostr (Row-1); // 'sequence number ';
Worksheet. cells [row, 2]. Value: = aqry. fieldbyname ('keyword'). asstring; // 'file No'
Worksheet. cells [row, 3]. Value: = aqry. fieldbyname ('title'). asstring; // 'title'
Worksheet. cells [row, 4]. Value: = aqry. fieldbyname ('zrz'). asstring; // 'response'
Worksheet. cells [row, 5]. Value: = aqry. fieldbyname ('recorddate'). asstring; // 'date'
Worksheet. cells [row, 6]. Value: = aqry. fieldbyname ('bgqx'). asstring; // 'retention time'
Worksheet. cells [row, 7]. Value: = aqry. fieldbyname ('mj '). asstring; // 'confidentiality'
Worksheet. cells [row, 8]. Value: = aqry. fieldbyname ('controlid'). asstring; // 'control'
Aqry. Next;
Application. processmessages;
End;

Try
Excelapp. worksheets ['sheet1']. Activate; // sets an active sheet.
Excelapp. worksheets ['sheet1']. Delete; // Delete
Excelapp. worksheets ['sheet2']. Activate;
Excelapp. worksheets ['sheet2']. Delete;
Excelapp. worksheets ['sheet3']. Activate;
Excelapp. worksheets ['sheet3']. Delete;
Except
End;

If isexist then
Begin
If not excelapp. activeworkbook. Saved then
Excelapp. workbooks [1]. Save;
End
Else
Excelapp. workbooks [1]. saveas (afilename, 56); // fileformat: = 56 -- Office Excel 97-2003 format
Finally
// Rename after deletion
// Tmpfilename: = afilename;
// Delete (tmpfilename, pos (extractfileext (afilename), afilename), length (extractfileext (afilename )));
// Tmpfilename: = tmpfilename + '_ TMP' + extractfileext (afilename );
// Excelapp. activesheet. saveas (tmpfilename, 56); // fileformat: = 56 -- Office Excel 97-2003 format
{
Try
If fileexists (afilename) then
Deletefile (afilename );

Renamefile (tmpfilename, afilename );
Except
End;
}

Excelapp. workbooks. Close; // close the workbook.
If not varisempty (excelapp) then
Excelapp. Quit;
Excelapp: = unassigned;
End;
Result: = true;
End;

 

----------------------------------------

 

By jrq

2009/12/05 Nanjing