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;