excelunit.pas

工程预算系统

unit Excelunit;
                                                                   
interface
uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    Db, ADODB, ImgList, StdCtrls, Buttons, ComCtrls, dbctrls, menus,Variants,
    Math,ComObj,Gauges,grids,DBGrids,pubunit,Contnrs,printers, FR_Class,DBGridEh,
    Excel2000,pub_rep;

  {给单元格赋值}
  procedure SetCell(Fs,LS,Text:String);
  {将数字转换成为Excel列要求的格式}
  function Getabcd(i:integer):string;
  {表注部分导到Excel 格式}
  procedure bztoExcel(mygrid:TStringGrid;nr:integer;str:string;b_falg:boolean);
  {表注下导到Excel 格式}
  procedure bzxtoExcel(mygrid:TStringGrid;nr:integer);
  {把表头信息导到Excel}
  procedure bttoExcel(mygrid:TStringGrid;nr:integer);
  {将数据导到Eecel}
  procedure ExporttoExcel;
  {把人材机数据导到Excel}
  procedure rcjtoExcel(IsAllrcj:TdmAllrcj);      //报表导到Excel
  {取得表注部分的行数}
  function getline(nt:integer):integer;
  {取得表注下部分的行数}
  function getlinex(nt:integer):integer;
  {连接Excel}
  procedure LinkExcel;
  {取费表导到Excel}
  procedure qftoExcel;   //报表导到Excel
  {动态费率导到Excel}
  procedure dtfltoExcel;     //报表导到Excel
  {万用表导到Excel}
  procedure wybtoExcel;      //报表导到Excel
  {单价分析导到Excel}       ///报表导到Excel
  procedure djfxtoExcel;
  {单价分析固定部分（即表头）}
  procedure djfxbttoExcel(nr:integer);  //报表导到Excel
  {}
  procedure setdjfx(str1,str2,str3:string;nv,nh,nrow:integer;b_falg:boolean);
  {}
  procedure setdjfxbt(str1,str2,str3:string;nv,nh,nrow,nwidth:integer;b_falg:boolean);
  {计算表导到Excel}
  procedure jsbtoExcel;     //报表导到Excel
  {计算表竖排表导到Excel}   ///报表导到Excel
  procedure jsbhtoExcel;
  {计算表导到}
  procedure jsbhtoExcel1;    //报表导到Excel
  {将一个单元格导到Excel}
  procedure sethtoexcel(str1,str2,str3:string;nv,nh,nrow,nwidth,nmax:integer;b_falg:boolean);
  {计算该报表有多少列}
  function getcol(ntmp:integer):integer;
  {给单元格赋竖排值}
  procedure setspz(str1,str2,str3:string;nrow,nrow1:integer);
  {创建'合计'单元格}
  procedure sethj(str:string;nrow,nrow1:integer);
  {把信息导到Excel}
  procedure setxxtoExcel(str:string;nv,nh,nrow,nwidth,nmax,nc:integer);
  {另种对单元格赋值}
  procedure setcellxx(str:string;nv,nh,nrow,nwidth,nmax,nc,i:integer);
  {创建单元格}
  procedure setdyg(str:string;nrow,nrow1:integer);
  {给单价分析表头赋值}
  procedure djfxbztoexcel(nr:integer;str:string;b_falg:boolean);
  {表注部分导到Excel 格式}
  procedure jsbbztoExcel(nr:integer;str:string;b_falg:boolean);
  procedure jsbExportbzstoExcel(nr:integer);
 {表注下导到Excel 格式}
  procedure djfxbzxtoExcel(nr:integer);
  {表注下导到Excel 格式}
  procedure jsbbzxtoExcel(nr:integer);
  {设置小数点}
  function setnumber(str:string;ncol:integer):string;
  function setdjfxnumber(str:string):string;
  procedure sethtoexcel1(str1,str2,str3:string;nv,nh,nrow,nwidth,nmax:integer;b_falg:boolean);
  procedure sethtoexcel2(str1,str2,str3:string;nv,nh,nrow,nwidth,nmax:integer;b_falg:boolean);
  procedure sethtoexcel3(str1,str2,str3:string;nv,nh,nrow,nwidth,nmax:integer;b_falg:boolean);
  {设置宽度}
  procedure setwidthjsb(nlinew:integer);
  procedure setxxtoExcel1(str:string;nv,nh,nrow,nwidth,nmax,nc:integer);
  procedure setxxtoExcel2(str:string;nv,nh,nrow,nwidth,nmax,nc:integer);
  procedure setcellxx1(str:string;nv,nh,nrow,nwidth,nmax,nc,i:integer);
  function getlinecount1(str:string;ntmp:integer):integer;
  {对表注上的信息进行编辑}
  procedure ExportbzstoExcel(mygrid:TStringGrid;nr:integer);
var
  array_btxx:array [1..6] of string;
  array_tzxx:array [1..6] of string;
  bzslist:TObjectList;
  bzxlist:TObjectList;
  Excel_path:string;
implementation
  uses ys,hu_pub,MAIN,wordunit;
  
{给单元格赋值}
procedure SetCell(Fs,LS,Text:String);
begin
   if fs<>ls then mainform.ExcelApplication1.Range[fs,LS].MergeCells:=true; //合并单元格
     mainform.ExcelApplication1.Range[fs,LS].FormulaR1C1:=Text;    //为单元格赋值
end;

{将数字转换成为Excel列要求的格式}
function Getabcd(i:integer):string;
var
  Astr,Bstr,Cstr:string;
  K,J:integer;
begin
  k:=round(int(i/27));   //
  j:=i-k*27;
  Astr:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  Bstr:=Trim(Inttostr(i));
  Bstr:=copy(astr,k,1); //第一位
  cstr:=copy(astr,j,1); //第二位
  if k=0 then
    result:=cstr
  else
    result:=Bstr+cstr;
end;

{表注部分导到Excel 格式}
procedure bztoExcel(mygrid:TStringGrid;nr:integer;str:string;b_falg:boolean);
var
  ntemp,ncount:integer;
begin
  if Trim(array_jbxx[1])='1' then
    ncount:=mygrid.ColCount
  else
    ncount:=mygrid.ColCount-1;

  if (ncount mod 2)>0 then
    ntemp:=(ncount div 2)+1
  else
    ntemp:=ncount div 2;

  if Trim(str)<>'' then
  begin
    if b_falg then
    begin
      mainform.ExcelApplication1.Range['B'+inttostr(nr),Getabcd(ntemp)+inttostr(nr)].MergeCells:=True;
      mainform.ExcelApplication1.Range['B'+inttostr(nr),Getabcd(ntemp)+inttostr(nr)].RowHeight:=20*0.75;
      mainform.ExcelApplication1.Range['B'+inttostr(nr),Getabcd(ntemp)+inttostr(nr)].VerticalAlignment:=xlCenter;
      mainform.ExcelApplication1.Range['B'+inttostr(nr),Getabcd(ntemp)+inttostr(nr)].HorizontalAlignment:=xlLeft;
       mainform.ExcelApplication1.Range['B'+inttostr(nr),Getabcd(ntemp)+inttostr(nr)].Font.Size:=9;
      mainform.ExcelApplication1.Range['B'+inttostr(nr),Getabcd(ntemp)+inttostr(nr)].FormulaR1C1:=Trim(str);
    end
    else
    begin
      mainform.ExcelApplication1.Range[Getabcd(ntemp+1)+inttostr(nr),Getabcd(ncount+1)+inttostr(nr)].MergeCells:=True;
      mainform.ExcelApplication1.Range[Getabcd(ntemp+1)+inttostr(nr),Getabcd(ncount+1)+inttostr(nr)].RowHeight:=20*0.75;
      mainform.ExcelApplication1.Range[Getabcd(ntemp+1)+inttostr(nr),Getabcd(ncount+1)+inttostr(nr)].VerticalAlignment:=xlCenter;
      mainform.ExcelApplication1.Range[Getabcd(ntemp+1)+inttostr(nr),Getabcd(ncount+1)+inttostr(nr)].HorizontalAlignment:=xlright;
      mainform.ExcelApplication1.Range[Getabcd(ntemp+1)+inttostr(nr),Getabcd(ncount+1)+inttostr(nr)].Font.Size:=9;
      mainform.ExcelApplication1.Range[Getabcd(ntemp+1)+inttostr(nr),Getabcd(ncount+1)+inttostr(nr)].FormulaR1C1:=Trim(str);
    end;
  end;

end;

{对表注上的信息进行编辑}
procedure ExportbzstoExcel(mygrid:TStringGrid;nr:integer);
var
  ncount:integer;
  strcol:string;
begin
  if Trim(array_jbxx[1])='1' then
    ncount:=mygrid.ColCount
  else
    ncount:=mygrid.ColCount-1;

  strcol:=Getabcd(ncount+1);

//创建报表标题
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].MergeCells:=True;
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].RowHeight:=40*0.75;
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].VerticalAlignment:=xlCenter;
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].HorizontalAlignment:=xlCenter;
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].Font.Name:=Trim(array_jbxx[14]);
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].Font.Size:=strtoint(Trim(array_jbxx[15]));
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].Font.Color:=strtoint(Trim(array_jbxx[16]));
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].Font.FontStyle:='加粗';
  mainform.ExcelApplication1.Range['A'+inttostr(nr),strcol+inttostr(nr)].FormulaR1C1:=Trim(array_jbxx[12]);
//创建表注部分
  mainform.ExcelApplication1.Range['A'+inttostr(nr+1),strcol+inttostr(nr+1)].RowHeight:=10;

  if Trim(array_jbxx[26])<>'' then
    bztoExcel(mygrid,nr+2,getstr(array_jbxx[26]),True);
  if Trim(array_jbxx[27])<>'' then
    bztoExcel(mygrid,nr+3,getstr(array_jbxx[27]),True);
  if Trim(array_jbxx[28])<>'' then
    bztoExcel(mygrid,nr+4,getstr(array_jbxx[28]),True);
  if Trim(array_jbxx[32])<>'' then
    bztoExcel(mygrid,nr+2,getstr(array_jbxx[32]),False);
  if Trim(array_jbxx[33])<>'' then
    bztoExcel(mygrid,nr+3,getstr(array_jbxx[33]),False);
  if Trim(array_jbxx[34])<>'' then
    bztoExcel(mygrid,nr+4,getstr(array_jbxx[34]),False);
end;

{表注下导到Excel 格式}
procedure bzxtoExcel(mygrid:TStringGrid;nr:integer);
begin
  if Trim(array_jbxx[35])<>'' then
    bztoExcel(mygrid,nr,getstr(array_jbxx[35]),True);
  if Trim(array_jbxx[38])<>'' then
    bztoExcel(mygrid,nr+1,getstr(array_jbxx[38]),True);
  if Trim(array_jbxx[41])<>'' then
    bztoExcel(mygrid,nr+2,getstr(array_jbxx[41]),True);
  if Trim(array_jbxx[37])<>'' then
    bztoExcel(mygrid,nr,getstr(array_jbxx[37]),False);
  if Trim(array_jbxx[40])<>'' then
    bztoExcel(mygrid,nr+1,getstr(array_jbxx[40]),False);
  if Trim(array_jbxx[43])<>'' then
    bztoExcel(mygrid,nr+2,getstr(array_jbxx[43]),False);
end;

{把表头信息导到Excel}
procedure bttoExcel(mygrid:TStringGrid;nr:integer);
var
  i,j:integer;
  ndown:integer;
  nright:integer;
  nl:integer;   //距左边
  nrowcount:integer;
  rs,cs:string;
begin
  if Trim(array_jbxx[1])='1' then
    nl:=1
  else
    nl:=0;

  nrowcount:=mygrid.RowCount;

  if Trim(array_jbxx[1])='1' then
  begin
    mainform.ExcelApplication1.Range['B'+inttostr(nr),'B'+inttostr(nr+strtoint(array_jbxx[44])-1)].VerticalAlignment:=xlCenter;
    mainform.ExcelApplication1.Range['B'+inttostr(nr),'B'+inttostr(nr+strtoint(array_jbxx[44])-1)].HorizontalAlignment:=xlCenter;
    if nrowcount=6 then
      mainform.ExcelApplication1.Range['B'+inttostr(nr),'B'+inttostr(nr+strtoint(array_jbxx[44])-1)].FormulaR1C1:='序号'
    else if nrowcount>6 then
    begin
      mainform.ExcelApplication1.Range['B'+inttostr(nr),'B'+inttostr(nr+strtoint(array_jbxx[44])-1)].MergeCells:=True;
      mainform.ExcelApplication1.Range['B'+inttostr(nr),'B'+inttostr(nr+strtoint(array_jbxx[44])-1)].FormulaR1C1:='序' + chr(10)+ '号';
    end;
  end;

  for i:=5 to strtoint(array_jbxx[44])+4 do   //TStringGrid.Row
  begin
    for j:=1 to strtoint(array_jbxx[45])-1 do //TStringGrid.Col
    begin
//      ntop:=getheightup(mygrid.Cells[j,i]);
      ndown:=getheightdown(mygrid.Cells[j,i]);
///      nleft:=getwidthl(mygrid.Cells[j,i]);
      nright:=getwidthr(mygrid.Cells[j,i]);

      rs:=Getabcd(j+1+nl)+inttostr(nr+i-5);
      cs:=Getabcd(j+nright+nl+1)+inttostr(nr+ndown+i-5);

      mainform.ExcelApplication1.Range[rs,cs].VerticalAlignment:=xlCenter;
      mainform.ExcelApplication1.Range[rs,cs].HorizontalAlignment:=xlCenter;

      SetCell(rs,cs,gettitle(mygrid.Cells[j,i]));
      mainform.ExcelApplication1.Range['B'+inttostr(nr+i-5),Getabcd((getactiveform as TFrm_ys).temp_grid.ColCount+1)+inttostr(nr+i-5)].Borders.LineStyle:=xlContinuous;
    end;
  end;
end;
{}
function getline(nt:integer):integer;
var
  ntmp:integer;
begin
 if ((Trim(array_jbxx[26])<>'') or (Trim(array_jbxx[32])<>'')) and
   ((Trim(array_jbxx[27])<>'') or (Trim(array_jbxx[33])<>'')) and
   ((Trim(array_jbxx[28])<>'') or (Trim(array_jbxx[34])<>''))  then
    ntmp:=3
  else
 if ((Trim(array_jbxx[26])<>'') or (Trim(array_jbxx[32])<>'')) and
   ((Trim(array_jbxx[27])='') or (Trim(array_jbxx[33])='')) and
   ((Trim(array_jbxx[28])<>'') or (Trim(array_jbxx[34])<>''))  then
   ntmp:=3
  else
 if ((Trim(array_jbxx[26])='') and (Trim(array_jbxx[32])='')) and
   ((Trim(array_jbxx[27])<>'') or (Trim(array_jbxx[33])<>'')) and
   ((Trim(array_jbxx[28])<>'') or (Trim(array_jbxx[34])<>''))  then
    ntmp:=3
  else
 if ((Trim(array_jbxx[26])='') and (Trim(array_jbxx[32])='')) and
   ((Trim(array_jbxx[27])<>'') or (Trim(array_jbxx[33])<>'')) and
   ((Trim(array_jbxx[28])='') and (Trim(array_jbxx[34])=''))  then
   ntmp:=2
 else
 if ((Trim(array_jbxx[26])<>'') or (Trim(array_jbxx[32])<>'')) and
   ((Trim(array_jbxx[27])<>'') or (Trim(array_jbxx[33])<>'')) and
   ((Trim(array_jbxx[28])='') and (Trim(array_jbxx[34])=''))  then
   ntmp:=2
  else
  if ((Trim(array_jbxx[26])<>'') or (Trim(array_jbxx[32])<>'')) and
   ((Trim(array_jbxx[27])='') and (Trim(array_jbxx[33])='')) and
   ((Trim(array_jbxx[28])='') and (Trim(array_jbxx[34])=''))  then
   ntmp:=1
   else
     ntmp:=0;
   result:=ntmp;
end;
{把人材机数据导到Excel}
procedure rcjtoExcel(IsAllrcj:TdmAllrcj);
var