多表头导出Excel

procedure   TForm1.Button1Click(Sender:   TObject);   
          var   
                  AppExcel:variant;   
  begin   
          AppExcel: = CreateOleObject( ' Excel.Application');   
          AppExcel.visible: = true ;   
          AppExcel.WorkBooks.add();   
          AppExcel.WorkBooks[ 1 ].WorkSheets[ 1 ].Range[ ' A1:C2'].select;   
          AppExcel.Selection.Merge;   
   end ;   

 

  public    
          ExcelApp:   Variant;   
          dbgrideh2:Tdbgrideh;   
          query2:Tquery;   
     Function tocell() function   tocell(i,   j:   integer):   string;                               //把行列转换为EXCEL的单元格的格式   
    Function power26()function   power26(x:   Integer):   Integer;                                 //26的x次方函数   
    Function inttoz26()function   inttoz26(value:   Integer):   String;                         //整数转换为excel形式的26进制函数   
    Function z26toint()function   z26toint(value:   string):   Integer;                         //整数转换为excel形式的26进制的逆函数   
    Function excel_open()function   excel_open(filename,appCaption:string):integer;   
    Function excel_merge()function   excel_merge(title_row,title_col,all_rowcount:integer):integer;   
    procedure   outtoexcel(filename,appcaption:string;dbgrideh:Tdbgrideh;cs_jqdh:integer;cs_s1:string;cs_s2:string;cs_i1:integer;cs_i2:integer);   
    
        {   Public   declarations   }   
    end;   
    
  var   
    Form1:   TForm1;   
      
  implementation   
    
  {$R   *.DFM}   
    
    
  Function TForm1()function   TForm1.z26toint(value:   string):   Integer;   
  var   
    i:   Integer;   
  begin   
    result   :=   0;   
    for   i   :=   1   to   length(value)   do   
    begin   
        result   :=   result   +   (ord(upcase(value[i]))   -   64)*power26(length(value)-i);   
    end;   
  end;   
    
  Function TForm1()function   TForm1.inttoz26(value:   Integer):   String;   
  var   
    left,d:   Integer;   
    c:   char;   
  begin   
    left   :=   value;   
    result   :=   '';   
    while   left>0   do   
    begin   
        d   :=   left   mod   26;   
        left   :=   left   div   26;   
        if   d   =   0   then   
        begin   
            c   :=   'Z';   
            dec(left);   
        end   
        else   
            c   :=   chr(d+64);   
        result   :=   c   +   result;   
    end;   
  end;   
    
  Function TForm1()function   TForm1.power26(x:   Integer):   Integer;   
  var   
    m:   Integer;   
  begin   
    result   :=   1;   
    for   m   :=   1   to   x   do   
        result   :=   26*result;   
  end;   
    
  Function TForm1()function   TForm1.tocell(i,   j:   integer):   string;   
  begin   
    result   :=inttoz26(j)+inttostr(i);   
  end;   
    
  Function TForm1()function   TForm1.excel_open(filename,appcaption:string):integer;   
  begin   
          try   
          result:=-1;   
          ExcelApp   :=   CreateOleObject(   'Excel.Application'   );   
          ExcelApp.Visible   :=   True;   
          ExcelApp.Caption   :=   appcaption;   
          ExcelApp.WorkBooks.Open(   filename   );   
          result:=1;   
          except   
                application.MessageBox('没有安装EXCEL!!','提示',64);   
          end;   
  end;   
    
  Function TForm1()function   TForm1.excel_merge(title_row,title_col,all_rowcount:integer):integer;   
  var   
      str_title,str_all,str_data,excel_start,excel_end:string;   
      i,j,k,l,jl_col,jl_row   :   integer;   
      ls_row,ls_col,ls_rowcount:integer;   
      arr   :array   of   array   of   integer;   
      arr_str:array   of   string;   
  begin   
          ls_row:=title_row;   
          ls_col:=title_col;   
          ls_rowcount:=all_rowcount;   
          setlength(arr,ls_row+1);         //初始化   
          for   i:=0   to   ls_row   do   
          begin   
                setlength(arr[i],ls_col+1);   
          end;   
          for   i:=0   to   length(arr)-1   do   
          begin   
                  for   j:=0   to   length(arr[i])-1   do   
                        arr[i][j]:=0;   
          end;   
          setlength(arr_str,0);   
          for   i:=1   to   ls_row   do   
          begin   
                    for   j:=1   to   ls_col   do   
                    begin   
                            if   trim(ExcelApp.Cells[i,j].Value)<>''   then   
                            begin   
                                  excel_start:=tocell(i,j);   
                                  arr[i][j]:=1;     //表示已经使用   
                                  jl_col:=j;   
                                  for   l:=j+1   to   ls_col   do   
                                  begin   
                                        if   (trim(ExcelApp.Cells[i,l].Value)='')   and   (arr[i][l]<>1)   then   
                                        begin   
                                                jl_col:=l;   
                                                arr[i][l]:=1;   
                                        end   else   
                                              break;   
                                  end;   
                                  jl_row:=i;   
                                  for   l:=i+1   to   ls_row   do   
                                  begin   
                                        if   (trim(ExcelApp.Cells[l,j].Value)='')   and   (arr[l][j]<>1)   then   
                                        begin   
                                                    jl_row:=l;   
                                                    arr[l][j]:=1;   
                                        end   else   
                                        begin   
                                                break;   
                                        end;   
                                  end;   
                                  excel_end:=tocell(jl_row,jl_col);   
                                  if   excel_start<>excel_end   then   
                                  begin   
                                  str_title:=excel_start+':'+excel_end;   
                                  setlength(arr_str,length(arr_str)+1)   ;   
                                  arr_str[length(arr_str)-1]:=str_title;   
                                  end;   
                            end;   
                    end;   
          end;   
    
          str_title:=   'A1:'+tocell(ls_row,ls_col);   
          for   i:=0   to   length(arr_str)-1   do   
          begin   
              ExcelApp.Range[arr_str[i]].Select;   
              ExcelApp.Selection.Merge;   
          end;   
          ExcelApp.ActiveSheet.range[str_title].Font.Bold       :=   True;   
          ExcelApp.ActiveSheet.range[str_title].HorizontalAlignment:=3;     //居中   
          ExcelApp.ActiveSheet.range[str_title].VerticalAlignment:=2;         //居中   
          ExcelApp.ActiveSheet.range[str_title].Borders.LineStyle   :=   1;     //加边框   
          ExcelApp.ActiveSheet.Range[str_title].Borders[1].Weight   :=   3;   
          ExcelApp.ActiveSheet.Range[str_title].Borders[2].Weight   :=   3;   
          ExcelApp.ActiveSheet.Range[str_title].Borders[3].Weight   :=   3;   
          ExcelApp.ActiveSheet.Range[str_title].Borders[4].Weight   :=   3;   
          ExcelApp.ActiveSheet.range[str_title].Interior.ColorIndex   :=19   ;   //鹅黄色   
          str_all:='A1:'+tocell(ls_rowcount+ls_row,ls_col);   
          str_data:=tocell(ls_row+1,1)+':'+tocell(ls_rowcount+ls_row,ls_col);   
          ExcelApp.ActiveSheet.range[str_data].Borders.LineStyle   :=   1;   
          ExcelApp.ActiveSheet.range[str_all].Columns.AutoFit;   
    
          //ExcelApp.ActiveSheet.Range[   'A1:D3'   ].Borders[5].Weight   :=   3;   //交叉   
          //ExcelApp.ActiveSheet.Range[   'A1:D3'   ].Borders[6].Weight   :=   3;     //交叉   
          //ExcelApp.ActiveWorkBook.Saved   :=   true;   //放弃存盘   
          //ExcelApp.Cells[4,1].Value:='反复发';   
          if   not   ExcelApp.ActiveWorkBook.Saved   then       //保存   
                ExcelApp.ActiveWorkBook.Save;   
          ExcelApp:=Unassigned;   
            //   ExcelApp.quit;   
  end;   
  procedure   TForm1.outtoexcel(filename,appcaption:string;dbgrideh:Tdbgrideh;cs_jqdh:integer;cs_s1:string;cs_s2:string;cs_i1:integer;cs_i2:integer);   
  var   
      dbgridehexp   :TDBGridEhExportAsXLS;   
      i   :   integer;   
  begin   
          dbgridehexp   :=   TDBGridEhExportAsXLS.Create();   
          dbgridehexp.DBGridEh:=dbgrideh2;   
          dbgridehexp.ExportToFile(filename,TRUE);         //直接导出文件   
          if   excel_open(filename,appcaption)=-1   then         //打开excel   
                exit;   
          excel_merge(dbgridehexp.MutiTitle_RowCount,dbgridehexp.MutiTitle_ColCount,dbgridehexp.DBGridEh.DataSource.DataSet.Recordcount);   
                    //写数据格式   
  end;