⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 excelunit.pas

📁 工程预算系统
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  i,j:integer;
  ntopdis,nleftdis,nbottomdis,nrightdis:integer;//报表上,下,左,右边距的值
  dy:integer;                                //报表纸张的宽度和高度
  nh,nb:integer;                                   //标题离纸的高度
  ntop:integer;                                //表头离纸的高度
  nbottomtop:integer;                          //纸张表注部分所占的高度
  nhheight:integer;                           //表头边框的高度
  rcj:Tjc_rcj;
  ntup:integer;
  strselectid:string;
  ntempcount:integer;
  nmin,nmax:integer;
  nht:integer;
  nrow:integer;
  nl:integer;
  ntmppage:integer;
begin
  if (getactiveform as TFrm_ys).tv_js.Selected<>nil then
    strselectid:=PData2((getactiveform as TFrm_ys).tv_js.Selected.Data)^.ID
  else
    abort;

  getxx(strselectid);  //取得报表基本信息
  setxx(strselectid,(getactiveform as TFrm_ys).temp_grid);   //给临时的grid赋值
  if IsAllrcj = dmAllrcj then
    getrcj
  else if IsAllrcj =dmjc then
    getjc(PData2((getactiveform as Tfrm_ys).tv_js.Selected.Data)^.bh);

  if Trim(array_jbxx[1])='1' then
    nl:=1
  else
    nl:=0;

  nht:=strtoint(array_jbxx[48]);
  ntopdis:=strtoint(array_jbxx[5])*3;
  nbottomdis:=strtoint(array_jbxx[7])*3;
  nleftdis:=strtoint(array_jbxx[4])*3;
  nrightdis:=strtoint(array_jbxx[6])*3;

  nhheight:=gethead((getactiveform as TFrm_ys).temp_grid,strtoint(array_jbxx[48]));

  if Trim(array_jbxx[8])='1' then
    dy:=getpageh(0,True)
  else
    dy:=getpageh(0,False);

  nh:=getup(array_jbxx[26],array_jbxx[27],array_jbxx[28],array_jbxx[29],array_jbxx[30],array_jbxx[31],array_jbxx[32],array_jbxx[33],array_jbxx[34]);
  nb:=getup(array_jbxx[35],array_jbxx[38],array_jbxx[41],array_jbxx[36],array_jbxx[39],array_jbxx[42],array_jbxx[37],array_jbxx[40],array_jbxx[43]);

  ntop:=ntopdis+60+nh;                    //表头开始离纸的高度
  nbottomtop:=dy-nbottomdis-nb;           //作为换页的依据;

  ntempcount:=0;  ntmppage:=0;
  while ntempcount<=rcjlist.Count do
  begin
    ntup:=ntop+nhheight;
    for i:=ntempcount to rcjlist.Count-1 do
    begin
      nmax:=1;
      for j:=1 to (getactiveform as TFrm_ys).temp_grid.ColCount-1 do
      begin
        nmin:=getlinecount(calrcj(i,(getactiveform as TFrm_ys).temp_grid,j),(getactiveform as TFrm_ys).temp_grid.ColWidths[j]);
        if nmin>nmax then
          nmax:=nmin;
      end;
      ntup:=ntup+nht*nmax;
      if ntup+30>nbottomtop then
        break;
    end;
    ntempcount:=i+1;
    inc(ntmppage);
  end;
  npagecount:=ntmppage;

  LinkExcel;
  try
  mainform.ExcelWorksheet1.PageSetup.BottomMargin:=nbottomdis;
  mainform.ExcelWorksheet1.PageSetup.TopMargin:=ntopdis;
  mainform.ExcelWorksheet1.PageSetup.LeftMargin:=nleftdis;
  mainform.ExcelWorksheet1.PageSetup.RightMargin:=nrightdis;
  if Trim(array_jbxx[8])='0' then
    mainform.ExcelWorksheet1.PageSetup.Orientation:=xlLandscape;

  mainform.ExcelApplication1.Range['A1','A1'].ColumnWidth:=1;
    if Trim(array_jbxx[1])='1' then
      mainform.ExcelApplication1.Range['B1','B1'].ColumnWidth:=(getactiveform as TFrm_ys).temp_grid.ColWidths[0]/8-0.57;
 for j:=1 to (getactiveform as TFrm_ys).temp_grid.ColCount-1 do
    mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(1),Getabcd(j+nl+1)+inttostr(1)].ColumnWidth:=(getactiveform as TFrm_ys).temp_grid.ColWidths[j]/8-0.57;
  nrow:=0;
 ntempcount:=0;       npagetmp:=0;
  while ntempcount<=rcjlist.Count do
  begin

    if nrow=0 then
      nrow:=1
    else
      nrow:=nrow+getlinex(0)+1;
    //把表头导到
    npagetmp:=npagetmp+1;
   // ExportbzstoExcel(mygrid:TStringGrid;nr:integer);
    ExportbzstoExcel((getactiveform as TFrm_ys).temp_grid,nrow);
  //  bttoExcel(mygrid:TStringGrid;nr:integer);
    nrow:=nrow+2+getline(0);
    bttoExcel((getactiveform as TFrm_ys).temp_grid,nrow);

    nrow:=nrow+strtoint(array_jbxx[44]);
    ntup:=ntop+nhheight;
    //SHOWMESSAGE(inttostr(rcjlist.count));
    for i:=ntempcount to rcjlist.Count-1 do
    begin
      rcj:=Tjc_rcj(rcjlist.Items[i]);

      nmax:=1;
      for j:=1 to (getactiveform as TFrm_ys).temp_grid.ColCount-1 do
      begin
        nmin:=getlinecount(calrcj(i,(getactiveform as TFrm_ys).temp_grid,j),(getactiveform as TFrm_ys).temp_grid.ColWidths[j]);
        if nmin>nmax then
          nmax:=nmin;
      end;

      if Trim(array_jbxx[1])='1' then
      begin
      //  mainform.ExcelApplication1.Range['B'+inttostr(nrow),'B'+inttostr(nrow+strtoint(array_jbxx[44]))].MergeCells:=True;
        mainform.ExcelApplication1.Range['B'+inttostr(nrow),'B'+inttostr(nrow)].RowHeight:=nht*nmax*0.75;
        mainform.ExcelApplication1.Range['B'+inttostr(nrow),'B'+inttostr(nrow)].VerticalAlignment:=xlCenter;
        mainform.ExcelApplication1.Range['B'+inttostr(nrow),'B'+inttostr(nrow)].HorizontalAlignment:=xlCenter;
        mainform.ExcelApplication1.Range['B'+inttostr(nrow),'B'+inttostr(nrow)].Font.Size:=9;
        mainform.ExcelApplication1.Range['B'+inttostr(nrow),'B'+inttostr(nrow)].FormulaR1C1:=rcj.column1;
      end;

      for j:=1 to (getactiveform as TFrm_ys).temp_grid.ColCount-1 do
      begin
        //mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].MergeCells:=True;
        mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].VerticalAlignment:=xlCenter;
        mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].RowHeight:=nht*nmax*0.75;
       mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].Font.Size:=9;;
        mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].HorizontalAlignment:=xlleft;
        //mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].FormulaR1C1:=gettitle((getactiveform as TFrm_ys).temp_grid.Cells[j,i]);
        mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].WrapText:=True;
        if isnumber(calrcj(i,(getactiveform as TFrm_ys).temp_grid,j))=0  then
          mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].NumberFormatLocal:=setnumber(calrcj(i,(getactiveform as TFrm_ys).temp_grid,j),j);

        if (lowercase(Trim((getactiveform as TFrm_ys).temp_grid.Cells[j,1]))='mc') then
          mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].FormulaR1C1:=calrcj(i,(getactiveform as TFrm_ys).temp_grid,j)
        else if (i=rcjlist.Count-1) and (Trim(array_jbxx[46])='1')  and (Trim((getactiveform as TFrm_ys).temp_grid.Cells[j,4])='') then
          mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].FormulaR1C1:=''
        else if (i<rcjlist.Count) then
          mainform.ExcelApplication1.Range[Getabcd(j+1+nl)+inttostr(nrow),Getabcd(j+nl+1)+inttostr(nrow)].FormulaR1C1:=calrcj(i,(getactiveform as TFrm_ys).temp_grid,j);

      end;   //end for j

      mainform.ExcelApplication1.Range['B'+inttostr(nrow),Getabcd((getactiveform as TFrm_ys).temp_grid.ColCount+1)+inttostr(nrow)].Borders.LineStyle:=xlContinuous;
      nrow:=nrow+1;
      mainform.statusbar1.Panels[2].Text:='正在检查数据并导入到Excel['+inttostr(i+1)+'/'+inttostr(rcjlist.Count)+'],请稍候....................';
      mainform.StatusBar1.Update;

      ntup:=ntup+nht*nmax;
      if ntup+30>nbottomtop then
        break;


    end;   //end for i:=ntempcount
    ntempcount:=i+1;
    bzxtoExcel((getactiveform as TFrm_ys).temp_grid,nrow+1);
  end;     //end while

  mainform.excelworksheet1.SaveAs(Excel_path);//自动存档   ]
  mainform.ExcelWorkbook1.Close;
  mainform.ExcelApplication1.Quit;
  mainform.ExcelApplication1.Disconnect;
  mainform.ExcelWorkbook1.Disconnect;
  mainform.ExcelWorksheet1.Disconnect;
  except
    screen.Cursor:=crdefault;
    mainform.excelworksheet1.SaveAs(Excel_path);//自动存档   ]
    mainform.ExcelWorkbook1.Close;
    mainform.ExcelApplication1.Quit;
    mainform.ExcelApplication1.Disconnect;
    mainform.ExcelWorkbook1.Disconnect;
    mainform.ExcelWorksheet1.Disconnect;
  end;
//  mainform.ExcelWorksheet1.Cells.Borders.LineStyle[1,2]

  screen.Cursor:=crdefault;
  mainform.statusbar1.Panels[2].Text:='导入Excel成功!';
  mainform.statusbar1.Update;
  application.MessageBox('导入Excel成功','温馨提示',mb_iconinformation);
end;



{取得表注下部分的行数}
function getlinex(nt:integer):integer;
var
  ntmp:integer;
begin
 if ((Trim(array_jbxx[35])<>'') or (Trim(array_jbxx[41])<>'')) and
   ((Trim(array_jbxx[36])<>'') or (Trim(array_jbxx[42])<>'')) and
   ((Trim(array_jbxx[37])<>'') or (Trim(array_jbxx[43])<>''))  then
    ntmp:=3
  else
 if ((Trim(array_jbxx[35])<>'') or (Trim(array_jbxx[41])<>'')) or
   ((Trim(array_jbxx[36])='') or (Trim(array_jbxx[42])='')) and
   ((Trim(array_jbxx[37])<>'') or (Trim(array_jbxx[43])<>''))  then
   ntmp:=3
  else
 if ((Trim(array_jbxx[35])='') and (Trim(array_jbxx[41])='')) and
   ((Trim(array_jbxx[36])<>'') or (Trim(array_jbxx[42])<>'')) and
   ((Trim(array_jbxx[37])<>'') or (Trim(array_jbxx[43])<>''))  then
    ntmp:=3
  else
 if ((Trim(array_jbxx[35])='') and (Trim(array_jbxx[41])='')) and
   ((Trim(array_jbxx[36])<>'') or (Trim(array_jbxx[42])<>'')) and
   ((Trim(array_jbxx[37])='') and (Trim(array_jbxx[43])=''))  then
   ntmp:=2
 else
 if ((Trim(array_jbxx[35])<>'') or (Trim(array_jbxx[41])<>'')) and
   ((Trim(array_jbxx[36])<>'') or (Trim(array_jbxx[42])<>'')) and
   ((Trim(array_jbxx[37])='') and (Trim(array_jbxx[43])=''))  then
   ntmp:=2
  else
  if ((Trim(array_jbxx[35])<>'') or (Trim(array_jbxx[41])<>'')) and
   ((Trim(array_jbxx[36])='') and (Trim(array_jbxx[42])='')) and
   ((Trim(array_jbxx[37])='') and (Trim(array_jbxx[43])=''))  then
   ntmp:=1
   else
     ntmp:=0;
   result:=ntmp;
end;

{连接Excel}
procedure LinkExcel;
begin
  if uppercase(copy(trim(mainform.SaveDialog1.FileName),length(trim(mainform.SaveDialog1.FileName))-3,4))<>'.XLS' then
    Excel_path:=mainform.SaveDialog1.FileName+'.xls'
  else
    Excel_path:=mainform.SaveDialog1.FileName;
  if trim(Excel_path)='' then
    abort;
  if fileexists(Excel_path) then
  begin
    if application.MessageBox(pchar('在当前位置发现已经存在名为'+'"'+Excel_path+'"'+'的文件。'+#13#10
                                   +'是否替换现有的'+'"'+Excel_path+'"文件?'),'文件重名',mb_iconquestion+mb_yesno+mb_defbutton2)=IDno then
      abort
    else
    begin
      if deletefile(Excel_path)=false then  //0为删除文件失败
      begin
        application.MessageBox(pchar('在替换当前位置文件'+'"'+Excel_path+'"'+'失败。'+#13#10
                                    +'出错原因:源文件或目标文件可能正在使用!'),'提示',mb_iconinformation);
        abort;
      end;
    end;
  end;
  mainform.statusbar1.Panels[2].Text:='正在将数据导入到Excel,请稍候....................';
  mainform.StatusBar1.Update;
  screen.Cursor:=crhourglass;
  try
    mainform.ExcelApplication1.Connect;
  except
    application.MessageBox(pchar('与Excel应用程序连接失败!请确定是否已经装有Excel,或者Excel应用程序已被破坏!'+#13#10
                                +'如有必要,请联络程序设计人员!'),'温馨提示',mb_iconexclamation);
    screen.Cursor:=crdefault;
    abort;
  end;
  mainform.ExcelApplication1.Visible[0]:=True;  //不显示.Excel
  mainform.ExcelApplication1.Workbooks.Add(NUll,0);
  mainform.ExcelWorkbook1.ConnectTo(mainform.ExcelApplication1.Workbooks[1]);
  mainform.ExcelWorksheet1.ConnectTo(mainform.ExcelWorkbook1.Sheets[1] as _worksheet);
  mainform.ExcelApplication1.ActiveWindow.DisplayGridlines:=False;  
end;

{取费表导到Excel}
procedure qftoExcel;
var
  i,j:integer;
  ntopdis,nleftdis,nbottomdis,nrightdis:integer;//报表上,下,左,右边距的值
  dy:integer;                                //报表纸张的宽度和高度
  nh,nb:integer;                                   //标题离纸的高度
  ntop:integer;                                //表头离纸的高度
  nbottomtop:integer;                          //纸张表注部分所占的高度
  nhheight:integer;                           //表头边框的高度
  rcj:Tjc_rcj;
  ntup:integer;
  strselectid:string;
  ntempcount:integer;
  nmin,nmax:integer;
  nht:integer;
  nrow:integer;
  nl:integer;
  ntmppage:integer;
begin
  if (getactiveform as Tfrm_ys).tv_js.Selected<>nil then
    strselectid:=PData2((getactiveform as Tfrm_ys).tv_js.Selected.Data)^.ID
  else
    abort;

  getxx(strselectid);  //取得报表基本信息
  setxx(strselectid,(getactiveform as TFrm_ys).temp_grid);   //给临时的grid赋值
  getqf(pdata2((getactiveform as TFrm_ys).tv_js.Selected.Data)^.bh);

  if Trim(array_jbxx[1])='1' then
    nl:=1
  else
    nl:=0;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -