Delphi-to-Excel cell merge Solution

Upload the code first!

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 ('error! No Excel software is installed! ');
Exit;
End;
Fexcel. displayalerts: = false; // the pop-up dialog box is not displayed.
Try
Fworkbook: = fexcel. workbooks. Add;
DM. q_findprocess.first;
Lastfield1: = '';
Lastfield2: = '';
Lastfield3: = '';
Lastfield4: = '';
If DM. q_findprocess.recordcount> 0 then begin
// Add a header
J: = 1;
Fexcel. cells [J, 1]: = 'Project name ';
Fexcel. cells [J, 2]: = 'product name ';
Fexcel. cells [J, 3]: = 'mould ';
Fexcel. cells [J, 4]: = 'node ';
Fexcel. cells [J, 5]: = 'sequence No ';
Fexcel. cells [J, 6]: = 'item content ';
Fexcel. cells [J, 7]: = 'Planning date ';
Fexcel. cells [J, 8]: = 'actual date ';
Fexcel. cells [J, 9]: = 'status ';
Fexcel. cells [J, 10]: = 'note ';
Fexcel. cells [J, 11]: = 'type ';
// Add a table body
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. Cell [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. Cell [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 ('output Excel file completed... ');
Except
Showmessage ('error! Output file error! ');
Fworkbook. close;
Fexcel. Quit;
Exit;
End;
End;

Delphi-to-Excel cell merge Solution