Delphi 转EXCEL 合并单元格解决方案

标签：delphi   合并   excel   单元格   

废话少说先上传代码，自己看吧！

procedure TForm1.Button10Click(Sender: TObject);
var
  FExcel:Variant;
  FWorkbook:Variant;
  FWorkSheet:Variant;
  XlsFileName:String;
  i,j:Integer;
  Field1,field2,Field3,Field4:string;
  LastField1,LastField2,Lastfield3,LastField4:string;
   savedailog:TSaveDialog;
begin
   savedailog:=TSaveDialog.Create(Self);
   savedailog.Filter:=‘Excel files (*.xls)|*.XlS‘;
   if savedailog.Execute then begin
        xlsfilename:=savedailog.FileName;
        savedailog.Free;
     end
   else begin
      savedailog.Free;
      exit;
   end;
  screen.Cursor := crHourGlass;
  Try
     FExcel := CreateOleObject(‘Excel.application‘);
  except
     screen.Cursor:=crDefault;
     ShowMessage(‘出错！没有安装Excel软件！‘);
     exit;
  end;
  FExcel.DisplayAlerts :=false ; //不提示弹出对话框
  try
     FWorkbook :=FExcel.WorkBooks.Add;
     DM.Q_FindProcess.First;
     LastField1:=‘‘;
     LastField2:=‘‘;
     Lastfield3:=‘‘;
     Lastfield4:=‘‘;
     if DM.Q_FindProcess.RecordCount >0 then begin
        //添加表头
        j:=1;
              FExcel.cells[j,1]:=‘项目名称‘;
              FExcel.cells[j,2]:=‘产品名称‘;
              FExcel.cells[j,3]:=‘模具‘;
              FExcel.cells[j,4]:=‘节点‘;
              FExcel.cells[j,5]:=‘序号‘;
              FExcel.cells[j,6]:=‘事项内容‘;
              FExcel.cells[j,7]:=‘计划日期‘;
              FExcel.cells[j,8]:=‘实际日期‘;
              FExcel.cells[j,9]:=‘状态‘;
              FExcel.cells[j,10]:=‘备注‘;
              FExcel.cells[j,11]:=‘类型‘;
        //添加表身
        for i:=1 to DM.Q_FindProcess.RecordCount do begin
            j:=i+1;
            Field1:=DM.Q_FindProcessMainProjectName.AsString;
            field2:=DM.Q_FindProcessSubProjectName.AsString;
            field3:=DM.Q_FindProcessMouldName.AsString;
            field4:=DM.Q_FindProcessProjectStatusName.AsString;
            try
              FExcel.cells[j,1]:=DM.Q_FindProcessMainProjectName.AsString;
              FExcel.cells[j,2]:=DM.Q_FindProcessSubProjectName.AsString;
              FExcel.cells[j,3]:=DM.Q_FindProcessMouldName.AsString;
              FExcel.cells[j,4]:=DM.Q_FindProcessProjectStatusName.AsString;
              FExcel.cells[j,5]:=DM.Q_FindProcessSeq.AsString;
              FExcel.cells[j,6]:=DM.Q_FindProcessWorkContent.AsString;
              FExcel.cells[j,7]:=DM.Q_FindProcessPlanDatePoint.AsString;
              FExcel.cells[j,8]:=DM.Q_FindProcessActDatePoint.AsString;
              FExcel.cells[j,9]:=DM.Q_FindProcessSubStatus.AsString;
              FExcel.cells[j,10]:=DM.Q_FindProcessRemark.AsString;
              FExcel.cells[j,11]:=DM.Q_FindProcessSubProjectType.AsString;
              if Field1 = LastField1 then
                 FExcel.Range[FExcel.Cells[j-1,1],FExcel.Cells[j,1]].MergeCells:=True;
              if Field2 = LastField2 then
                 FExcel.Range[FExcel.Cells[j-1,2],FExcel.Cells[j,2]].MergeCells:=True;
              if Field3 = LastField3 then
                 FExcel.Range[FExcel.Cells[j-1,3],FExcel.Cells[j,3]].MergeCells:=True;
              if Field4 = LastField4 then
                 FExcel.Range[FExcel.Cells[j-1,4],FExcel.Cells[j,4]].MergeCells:=True;
              LastField1 := Field1;
              LastField2 := Field2;
              LastField3 := Field3;
              LastField4 := Field4;
            finally
              FExcel.Visible := true;
              Screen.Cursor := crDefault;
            end;
            DM.Q_FindProcess.Next;
        end;
     end;
     FWorkSheet.saveas(xlsfilename);
     FExcel.quit;
     ShowMessage(‘输出 Excel 文件已完成。。。‘);
  Except
     ShowMessage(‘出错！输出文件错误！‘);
     FWorkBook.Close;
     FExcel.Quit;
     Exit;
  end;
end;

Delphi 转EXCEL 合并单元格解决方案

标签：delphi   合并   excel   单元格   

原文地址：http://blog.csdn.net/trassion/article/details/39250405