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;


  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值