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;