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 南京