Tdbgrideh Export to *.xls file

Procedure Dbgridtoexcel (Dbgrid:tdbgrideh; fname:string);
Const
msoScaleFromTopLeft = $00000000;
Msoscalefrommiddle = $00000001;
Msoscalefrombottomright = $00000002;
MsoTrue = $FFFFFFFF;
MsoFalse = $00000000;
Var
Excelobj, WorkBook, sheet:olevariant;
Oldcursor:tcursor;
Row,col, Fieldindex:integer;

Dataset:tdataset;
Savedialog:tsavedialog;
savefilename:string;
Begin
{If the DataSet is not open, exit}
if (DbGrid.DataSource.DataSet = nil) or (dbGrid.DataSource.DataSet.Active =false) or ( DbGrid.DataSource.DataSet.RecordCount = 0) Then
Begin
Messagedlg (' No data! ', mtwarning,[mbok],0);
Abort
End

Savedialog:=tsavedialog.create (Nil);
Savedialog.filename:= fname;
Savedialog.filter: = ' Microsoft Excel file |*.xls ';
If Savedialog.execute Then
Begin
UpdateWindow (GetActiveWindow);
Savefilename:= Savedialog.filename;
Savedialog.free;
End Else
Begin
Savedialog.free;
Exit
End

Dataset:= DbGrid.DataSource.DataSet;

{Saves the current mouse cursor,
Then turn the mouse cursor into a wait cursor, indicating that the following operation may take some time}
Oldcursor:=screen.cursor;
Screen.cursor:=crhourglass;
{Prepare to convert required Excel object, if failed, pop-up prompt}
Try
Excelobj: = Createoleobject (' Excel.Sheet ');
ExcelObj.Application.Visible: = Visible; {Make Excel invisible}

{ExcelObj.Application.ActiveWorkBook is not used here to solve
Olevariant object and actual Excel object Lifetime conflict in Delphi}
WorkBook: = EXCELOBJ.APPLICATION.WORKBOOKS.ADD;

Sheet:= Workbook.sheets[1];
sheet.cells.font.size:=9;
Sheet.Cells.Font.Name: = ' Arial ';
Except
MessageBox (GetActiveWindow, ' cannot call Mircorsoft excel! ' +chr (+CHR) (10) +
' Please check if Mircorsoft Excel is installed. ', ' hint ', mb_ok+mb_iconinformation);
Screen.cursor:=oldcursor;
Exit;
End

Try
{transform: Through looping, first convert title, then convert table contents}
Sheet.activate;

Column headings
Row:=1;
Col:=1;
For fieldindex:=0 to Dbgrid.columns.count-1 do
Begin
if (Dbgrid.columns[fieldindex]. Field <> Nil) Then
Begin
Sheet.cells[row,col]:=dbgrid.columns[fieldindex]. Field.displaylabel;
Sheet.cells[row,col]. Interior.Color: = RGB (191,191,191);
INC (Col);
End
End
SHEET.ROWS[1]. Font.Bold: = True;

Table content
Dataset.first;
While not dataset.eof do
Begin
row:=row+1;
Col:=1;
For fieldindex:=0 to Dbgrid.columns.count-1 do
Begin
if (Dbgrid.columns[fieldindex]. Field <> Nil) Then
Begin
if (Dbgrid.columns[fieldindex]. Field.datatype = ftstring)
or (Dbgrid.columns[fieldindex]. Field.datatype = Ftunknown)
or (Dbgrid.columns[fieldindex]. Field.datatype = ftwidestring) Then
Begin
Sheet.cells[row,col].  numberformatlocal:= ' @ '; formatting text
If Length (DBGrid. Columns[fieldindex]. field.asstring) >
Sheet.cells[row,col]. WrapText: = True; Wrap Line
End

Sheet.cells[row,col]:=dbgrid. Columns[fieldindex]. field.asstring;
INC (Col);
End
End

Dataset.next;
End

Workbook.saveas (filename:= savefilename);

Application.messagebox (' Data has been successfully exported to Excel! ', ' export success ', mb_ok+mb_iconinformation);

Finally
sheet:=unassigned;
{ExcelObj.Application.ActiveWorkBook is not used here to solve
Olevariant object and actual Excel object Lifetime conflict in Delphi}
WorkBook: = UnAssigned;
Excelobj: = UnAssigned;

Screen.cursor:=oldcursor; {All work is completed, the mouse cursor changes to the original appearance}
End
End

Tdbgrideh Export to *.xls file