Delphi实现带有格式的Excel导出功能

1. 功能预览

---

运行预览

模板样式

---

存储返参

导出的Excel

2. 代码实现

//执行sql的函数
procedure TForm1.GetReportData(astrsql:string);
var
    strSQL,err:string;                              i:integer;
begin
    strSQL :='set QUOTED_IDENTIFIER off   '+astrsql;
    //strSQL := astrsql  ;
    //查询  可支持多个结果集的返回
    DM.qryReport.Active:=False;
    DM.qryReport.Close;
    DM.qryReport.SQL.Clear;
    DM.qryReport.SQL.Add(strSQL);
    try
        DM.qryReport.Open;
    except on E: Exception do
        begin
            showmessage('执行SQL'+strsql+'异常!'+E.Message);
            Exit;
        end;
    end;
end;
//获取桌面的路径
function TForm1.GetShellFolders(strDir: string): string;
const
  regPath = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
var
  Reg: TRegistry;
  strFolders: string;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey(regPath, false) then
    begin
      strFolders := Reg.ReadString(strDir);
    end;
  finally
    Reg.Free;
  end;
  result := strFolders;
end;
//文件导出按钮的事件
procedure TForm1.btn1Click(Sender: TObject);
var
  excel,sheet :variant;
  iValidRows: Integer; // 工作表的有效行
  iValidCols: Integer; // 工作表的有效列
  i,j,k,affect:integer;
  strTemp,FieldName,reportname : string;//FieldName：对应数据的FieldName，
  isList,isReadRowCol,isListLine :boolean;//isList:是否包含list，isReadRowCol:是否已经读取到了list开始的行号和列号,isListLine:本行是不是包含List
  listColBegin,listColEnd:integer;//list的开始列号和结束列号
  aAdoDataSetMaster,aAdoDataSetList :TADODataSet;
begin
    GetReportData(trim(cbb2.Text));
    aAdoDataSetMaster :=TADODataSet.Create(Self);
    aAdoDataSetList:=TADODataSet.Create(Self);

    aAdoDataSetMaster.Recordset :=DM.qryReport.Recordset; //master数据集
    aAdoDataSetList.Recordset:=DM.qryReport.NextRecordset(affect);//list数据集

    excel := createoleobject('Excel.Application');
    excel.WorkBooks.open(trim(cbb1.Text));
    try
        sheet := excel.Application.ActiveSheet;//.WorkSheets['sheet1'];

        iValidRows := sheet.UsedRange.Rows.Count;    // 有效行数
        iValidCols := sheet.UsedRange.Columns.Count; // 有效列数
        //ShowMessage(IntToStr(iValidRows) + ', ' + IntToStr(iValidCols));

        listColEnd := ;
        isReadRowCol := false;
        if aAdoDataSetList.recordcount> then //list数据集有数据
        begin
            isList := true
        end
        else
            isList := false;

        if isList then
        begin
            for i :=  to iValidRows do
            begin
                for j :=  to iValidCols do
                begin
                    // 读工作表单元格
                    strTemp := trim(sheet.Cells.Item[i, j]);
                    if pos('(<list>)',strTemp)= then continue;
                    if pos('(<list>)',strTemp)> then
                    begin
                        if listColBegin= then listColBegin := j;
                        listColEnd := j;
                        isReadRowCol := true;
                    end;
                end;
                if isReadRowCol then
                begin
                    for k:= to aAdoDataSetList.recordcount- do
                    begin
                        excel.ActiveSheet.Rows[i+].Insert;
                        for j := listColBegin to listColEnd do
                        begin
                            strTemp := trim(sheet.Cells.Item[i, j]);
                            sheet.Cells.Item[i+, j]:=strTemp;
                        end
                    end;
                    break;//只要找到一个就行了
                end;
            end;
        end;
        iValidRows := sheet.UsedRange.Rows.Count;    // 有效行数
        iValidCols := sheet.UsedRange.Columns.Count; // 有效列数
        //ShowMessage(IntToStr(iValidRows) + ', ' + IntToStr(iValidCols));
        aAdoDataSetMaster.first;
        aAdoDataSetList.first;
        for i :=  to iValidRows do
        begin
            isListLine := false;
            for j :=  to iValidCols do
            begin
                // 读工作表单元格
                strTemp := trim(sheet.Cells.Item[i, j]);
                if (pos('(<field>)',strTemp)=) and (pos('(<list>)',strTemp)=) then continue;
                if pos('(<field>)',strTemp)> then
                begin
                    FieldName := copy(strTemp,pos('(<field>)',strTemp)+length('(<field>)'),pos('(</field>)',strTemp)-pos('(<field>)',strTemp)-length('(<field>)'));
                    strTemp := stringreplace(strTemp,strTemp,aAdoDataSetMaster.FieldByName(FieldName).AsString,[rfReplaceAll]);
                    sheet.Cells.Item[i, j] := strTemp;
                end
                else if pos('(<list>)',strTemp)> then
                begin
                    FieldName := copy(strTemp,pos('(<list>)',strTemp)+length('(<list>)'),pos('(</list>)',strTemp)-pos('(<list>)',strTemp)-length('(<list>)'));
                    strTemp := stringreplace(strTemp,strTemp,aAdoDataSetList.FieldByName(FieldName).AsString,[rfReplaceAll]);
                    sheet.Cells.Item[i, j] := strTemp;
                    isListLine := true;
                end;
            end;
            if isListLine then aAdoDataSetList.Next;
        end;
        reportname:=GetShellFolders('Desktop')+'\外挂报表-Excel导出数据.xlsx';
        sheet.SaveAs(reportname);
        //excel.ActiveWorkBook.SaveAs('g:\aa.xls');
    finally
        excel.Quit;
        sheet := Unassigned;
        excel := Unassigned;
    end;
    showmessage('导出完成：'+reportname);
end;