Delphi生成多Sheet的Excel文件

Delphi生成多Sheet的Excel文件的代码。

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

uses ComObj;

//生成Excel表格头信息。//by JRQ 20091205
procedure CreatExcelTitle(ExlApp: OleVariant; SheetName: string);
var Range: OleVariant;
begin
ExlApp.Cells[1, 1].Value := '序号'; //第一行第1列
ExlApp.Cells[1, 2].Value := '档号'; //第一行第2列
ExlApp.Cells[1, 3].Value := '题名';
ExlApp.Cells[1, 4].Value := '起始日期';
ExlApp.Cells[1, 5].Value := '终止日期';
ExlApp.Cells[1, 6].Value := '保管期限';
ExlApp.Cells[1, 7].Value := '密级';

Range := ExlApp.WorkSheets[SheetName].Range['A1:G1']; //单元格从A2到M2 Range.Merge; //合并单元格
Range.Rows.RowHeight := 25; //设置行高
Range.HorizontalAlignment := 3; //水平对齐方式

Range.Columns[1].ColumnWidth := 6; //序号
Range.Columns[2].ColumnWidth := 20; //档号
Range.Columns[3].ColumnWidth := 60; //题名
Range.Columns[4].ColumnWidth := 12; //起始日期
Range.Columns[5].ColumnWidth := 12; //终止日期
Range.Columns[6].ColumnWidth := 8; //保管期限
Range.Columns[7].ColumnWidth := 8; //密级
end;

//数据集保存到Excel文件。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;

//判断磁盘上是否已经存在Excel文件。
if FileExists(aFileName) then
isExist := True;

SheetName := '数据目录'+aNum; //第i个Sheet

try
ExcelApp := CreateOleObject('Excel.Application'); //首先创建 Excel 对象，使用ComObj:

if isExist then
ExcelApp.WorkBooks.Open(aFileName) //打开已存在的工作簿
else
WorkBook := ExcelApp.WorkBooks.Add; //新增一个工作簿

for i := 1 to ExcelApp.WorkSheets.Count do
begin
tmpSheetName := ExcelApp.WorkSheets[i].Name;

//如果有同名的Sheet，则删除之。
if tmpSheetName = SheetName then
begin
//ExcelApp.WorkSheets[SheetName].Activate; //设置一个活动的Sheet
//ExcelApp.WorkSheets[SheetName].Delete; //删除

ShowMessage('“' + SheetName + '”已经存在。请检查确认！');
ExcelApp.ActiveWorkBook.Saved := True; //放弃保存
ExcelApp.WorkBooks.Close; //关闭工作簿：

if not VarIsEmpty(ExcelApp) then
ExcelApp.Quit;

Result := False;
Exit;
end;
end;

WorkSheet := ExcelApp.WorkSheets.Add; //新建一个Sheet
ExcelApp.Visible := False;
WorkSheet.Name := SheetName; //Sheet名称
ExcelApp.WorkSheets[SheetName].Activate;
except
ShowMessage('创建 Excel 对象异常，生成Excel文件失败。请确认您的计算机是否安装了 Microsoft Office Excel 程序！');
ExcelApp.Quit;
Exit;
end;

CreatExcelTitle(ExcelApp, SheetName);
Row := 1;

try
aQry.First;
while not aQry.Eof do
begin
//写文件Excel
Row := Row + 1;
WorkSheet.Cells[Row, 1].Value := IntToStr(Row - 1); //'序号' ;
WorkSheet.Cells[Row, 2].Value := aQry.FieldByName('KEYWORD').AsString; //'档号'
WorkSheet.Cells[Row, 3].Value := aQry.FieldByName('TITLE').AsString; //'题名'
WorkSheet.Cells[Row, 4].Value := aQry.FieldByName('ZRZ').AsString; //'责任者'
WorkSheet.Cells[Row, 5].Value := aQry.FieldByName('RECORDDATE').AsString; //'日期'
WorkSheet.Cells[Row, 6].Value := aQry.FieldByName('BGQX').AsString; //'保管期限'
WorkSheet.Cells[Row, 7].Value := aQry.FieldByName('MJ').AsString; //'密级'
WorkSheet.Cells[Row, 8].Value := aQry.FieldByName('CONTROLID').AsString; //'划控'
aQry.Next;
application.ProcessMessages;
end;

try
ExcelApp.WorkSheets['Sheet1'].Activate; //设置一个活动的Sheet
ExcelApp.WorkSheets['Sheet1'].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
//删除后重命名
//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; //关闭工作簿
if not VarIsEmpty(ExcelApp) then
ExcelApp.Quit;
ExcelApp := Unassigned;
end;
Result := True;
end;

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

by JRQ

2009/12/05 南京