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 南京
|
请发表评论