Delphi 多数据集（sheet）导出到一个Excel文件中

公司要做一个执行一个存储过程返回多个数据集到TADOStroedProc中，然后把这些数据导出到一个Excel文件中，

百度加实践，总结如下：

1. 先获取数据

//创建相关控件数组：
//TabSheetA: array[0 .. 19] of TRzTabSheet; TDBGridA[0 .. 19]: array of TDBGridEh; TADOQueryA[0 .. 19]: array of TADOQuery; TDataSou//rceA[0 .. 19]: array of TDataSource;
//spmul是一个TADOStoredProc；

  spmul.Open; 
  aintf := spmul.Recordset;

  s := 0;

  while (aintf <> nil) do
  begin
    inc(s);

    i := s - 1;
    if not assigned(TabSheetA[i]) then
    begin

      TabSheetA[i] := TRzTabSheet.Create(pgcmul);
      TabSheetA[i].PageControl := pgcmul;
      //TabSheetA[i].Caption := '页签' + inttostr(s);
    end;
    if not assigned(TDBGridA[i]) then
    begin
      TDBGridA[i] := TDBGridEh.Create(TabSheetA[i]);
      TDBGridA[i].Parent := TabSheetA[i];
      TDBGridA[i].Align := alClient;
      TDBGridA[i].FrozenCols := 1;
      TDBGridA[i].Options := TDBGridA[i].Options + [dgrowselect] - [dgEditing];

    end;
    if not assigned(TADOQueryA[i]) then
    begin
      TADOQueryA[i] := TADOQuery.Create(TDBGridA[i]);
      TADOQueryA[i].Recordset := aintf;
    end;
    if not assigned(TDataSourceA[i]) then
    begin
      TDataSourceA[i] := TDataSource.Create(TADOQueryA[i]);
      TDataSourceA[i].DataSet := TADOQueryA[i];
      TDBGridA[i].Visible := True;
      TDBGridA[i].DataSource := TDataSourceA[i];
    end;
    // TabSheetA[i].Visible := True;
    TabSheetA[i].tabvisible := True;
    if assigned(TADOQueryA[i].FindField('fieldstr')) then
      addCGRidRegEh(TDBGridA[i], TADOQueryA[i].FieldByName('fieldstr')
        .AsString);
    if assigned(TADOQueryA[i].FindField('tabstr')) then
      TabSheetA[i].Caption := TADOQueryA[i].FieldByName('tabstr').AsString;
    if i > 19 then
      break;

    aintf := aintf.NextRecordset(RecordsAffected);
  end;

  Visiblepage := s;//记录数据集总数

2.导出

SetLength(SheetName, length(TabSheetA));
  for i := 0 to length(TabSheetA) do
    SheetName[i] := TabSheetA[i].Caption;
  MultdatasetToExcelEHnew(Visiblepage, SheetName, TDBGridA, TDataSourceA);

调用

function MultdatasetToExcelEHnew(Visiblepage: Integer;
  SheetName: array of String; TDBGridA: array of TDBGridEh;
  TDataSourceA: array of TDataSource): Boolean;

// 多数据集导出
function MultdatasetToExcelEHnew(Visiblepage: Integer;
  SheetName: array of String; TDBGridA: array of TDBGridEh;
  TDataSourceA: array of TDataSource): Boolean;
var
  MsExcel: variant;
  sheet: array of variant;
  dialogSave: TSaveDialog;
  i, j, PageC: Integer;
  str: string;
  strlist: TStringList;
  fExist: Boolean;
  ARow, iLoop: Word;
  range: variant; // 范围
  ProgressNum : Integer;
begin
  PageC := Visiblepage;
  setlength(sheet, PageC);
  dialogSave := TSaveDialog.Create(Application);  //获取存储路径
  dialogSave.Filter := 'Excel文件(*.xls) |*.xls';
  if dialogSave.Execute then
  begin

  CLoadingForm := TWaitPicForm.Create(Application);
  with CLoadingForm do
  begin
    CLoadingForm.Show;
    CLoadingForm.pbwaitprogress.Min := 0;
    CLoadingForm.pbwaitprogress.Max := 100;
//    CLoadingForm.Canvas.Unlock;
  end;

    screen.Cursor := crHourGlass;
    // ****创建MSEXCEL对象
    try
      MsExcel := CreateOleObject('Excel.Application');
    except
      ShowMessage('请确定您的计算机是否已正确安装Microsoft Excel ?');
      freeandnil(dialogSave);
      screen.Cursor := crDefault;
      Exit;
    end;
    try
      // ****以下代码先检测导出的文件是否已存在，如果已存在，则打开并增加一工作表，否则新建
      if fileExists(dialogSave.FileName) then
      begin
        fExist := True;
        MsExcel.workbooks.Open(dialogSave.FileName); // 打开已存在的文件
        for i := 0 to PageC - 1 do
          MsExcel.worksheets.Add; // 新增一工作表
      end
      else
      begin
        fExist := false;
        MsExcel.workbooks.Add; // 新建一工作簿
        for i := 0 to PageC - 1 do
          MsExcel.worksheets.Add; // 新增一工作表
      end;
      ProgressNum := 100 div PageC;
      for i := 0 to PageC - 1 do
      begin
        str := SheetName[i];
        sheet[i] := MsExcel.workbooks[1].worksheets[i + 1];
        // 判断是否存在同名表格
        try
          sheet[i].Name := str; // 为工作表命名
        except
          ShowMessage('该工作薄中已存在同名工作表:' + str + '！');
          MsExcel.quit; // 退出Excel
          MsExcel := Unassigned; // 释放MSEXCEL对象
          freeandnil(dialogSave);
          screen.Cursor := crDefault;
          Exit;
        end;
        //加载进度条
        for j := (i * ProgressNum) to ((i + 1) * ProgressNum) do
        begin
          CLoadingForm.pbwaitprogress.Position := j;
          sleep(10);
        end;
        // ****以下代码将DBGrid内容复制到粘贴板中
        for iLoop := 0 to TDBGridA[i].Columns.Count - 1 do
        begin
          sheet[i].cells[2, iLoop + 1] := TDBGridA[i].Columns[iLoop]
            .Title.Caption;
          if TDBGridA[i].Columns[iLoop].Width <= 64 then
          begin
            sheet[i].Columns[iLoop + 1].ColumnWidth := 4
          end
          else if (TDBGridA[i].Columns[iLoop].Width > 64) and
            (TDBGridA[i].Columns[iLoop].Width <= 100) then

            sheet[i].Columns[iLoop + 1].ColumnWidth := 8
          else if (TDBGridA[i].Columns[iLoop].Width > 100) and
            (TDBGridA[i].Columns[iLoop].Width <= 360) then
            sheet[i].Columns[iLoop + 1].ColumnWidth := 30
          else
            sheet[i].Columns[iLoop + 1].ColumnWidth := 60;
          Application.ProcessMessages;
          sheet[i].cells[2, iLoop + 1].HorizontalAlignment := -4108; // 字居中
          // sheet[i].cells[2, y + 1].Interior.Color := clGray; // 单元格背景色
          range := sheet[i].range[sheet[i].cells[2, iLoop + 1],
            sheet[i].cells[2, iLoop + 1]];
          // 选定表格
          range.borders.linestyle := 1; // 华线

          // sheet[i].Columns[y].c := 4; // 设置列宽度
        end;

        range := sheet[i].range[sheet[i].cells[1, 1],
          sheet[i].cells[1, TDBGridA[i].Columns.Count]]; // 选定表格
        sheet[i].cells[1, 1].HorizontalAlignment := -4108; // 字居中
        // range.Select;
        range.merge; // 合并单元格
        range.Characters.Font.size := 32;
        range.Characters.Font.Name := '微软雅黑';
        range.Characters.Font.FontStyle := '加粗';
        // Grid数据导出
        ARow := 3;
        with TDataSourceA[i].DataSet do
        begin
          DisableControls;
          First;
          while not Eof do
          begin

            for iLoop := 0 to TDBGridA[i].Columns.Count - 1 do
            begin
              sheet[i].cells[ARow, iLoop + 1] := Fields[iLoop].Value;
              range := sheet[i].range[sheet[i].cells[ARow, iLoop + 1],
                sheet[i].cells[ARow, iLoop + 1]];
              // 选定表格
              range.borders.linestyle := 1; // 华线
              Application.ProcessMessages;

            end;
            inc(ARow);
            Next;
          end;
          First;
          EnableControls;
        end;

      end;

      if fExist then // 保存文件
        MsExcel.workbooks[1].save
      else
        MsExcel.workbooks[1].SaveAs(dialogSave.FileName);

      if CLoadingForm.pbwaitprogress.Position = 100 then
      CLoadingForm.Close;
      ShowMessage('文件已成功导出至以下位置:' + dialogSave.FileName);
    except
      ShowMessage('文件不可用，请稍后重试！');
      freeandnil(strlist);
      MsExcel.quit; // 退出Excel
      MsExcel := Unassigned; // 释放MSEXCEL对象
      freeandnil(dialogSave);
      screen.Cursor := crDefault;
      Exit;
    end;

    freeandnil(strlist);
    MsExcel.quit; // 退出Excel
    MsExcel := Unassigned; // 释放MSEXCEL对象
    freeandnil(dialogSave);
    screen.Cursor := crDefault;
  end;
end;

期间还做了一个进度条窗体显示导出进度，但是不会用多线程，很尴尬， 就只做了一个ProgressBar并时时更新Position来表示进度（代码中的深绿色部分）

总结：总体导出效果似乎可以，但是感觉这个进度条做法不对，水平有限，先就这样吧。