إجراء تصدير بيانات من جدول إلى الأكسل بلغة الدلفي - Delphi Function Export To Excel File

هذا الإجراء يستخدم لتصدير بيانات من جدول داتابيس إلى ملف أكسل , بلغة الدلفي

function ExportToExcel(oDataSet : TDataSet; sFile : String; pName : String): Boolean;
var
   iCol,iRow : Integer;
   oExcel : TExcelApplication;
   oWorkbook : TExcelWorkbook;
   oSheet : TExcelWorksheet;
   vRowNo : integer;
   vFieldC : integer;
   vVarCol : OleVariant;
   lcid : integer;
begin
lcid := LOCALE_USER_DEFAULT;
result := True;
oExcel := TExcelApplication.Create(Application);
oWorkbook := TExcelWorkbook.Create(Application);
oSheet := TExcelWorksheet.Create(Application);
try
   oExcel.ConnectKind := ckNewInstance;
   oExcel.Visible[lcid] := False;
   oExcel.Connect;
except
   result := False;
   MessageDlg('Excel may not be installed', mtError, [mbOk], 0);
   exit;
end;

oExcel.Visible[lcid] := True;
oExcel.Caption := 'Title Excel Export ';
oExcel.Workbooks.Add(Null, lcid);

oWorkbook.ConnectTo(oExcel.Workbooks[1]);
oSheet.ConnectTo(oWorkbook.Worksheets[1] as _Worksheet);
oSheet.DisplayRightToLeft[lcid] := True;
iRow := 1;
vRowNo := oDataSet.RecordCount+1;
vFieldC := oDataSet.FieldCount;
case vFieldC of   // لتحديد الأعمدة والعمل على تلوينها حسب ما هو مطلوب  //
  1: vVarCol := 'A1';
  2: vVarCol := 'B1';
  3: vVarCol := 'C1';
  4: vVarCol := 'D1';
  5: vVarCol := 'E1';
  6: vVarCol := 'F1';
  7: vVarCol := 'G1';
  8: vVarCol := 'H1';
  9: vVarCol := 'I1';
  10: vVarCol := 'J1';

     //   Add as required //

end;

for iCol := 1 to oDataSet.FieldCount do
 begin
  oSheet.Cells.Item[iRow,iCol] := oDataSet.Fields[iCol-1].DisplayLabel;
 end;
oDataSet.First;
while NOT oDataSet.Eof do
begin
   Inc(iRow);
   for iCol := 1 to oDataSet.FieldCount do
   begin
   oSheet.Cells.Item[iRow,iCol] := oDataSet.Fields[iCol-1].AsString;
   end;
oDataSet.Next;
end;
oSheet.Name := pName;   // Change the wprksheet name.  //
                       //   Change Color and font to Title of page //
oSheet.Range['A1',vVarCol].EntireRow.Font.Color := clNavy;
oSheet.Range['A1',vVarCol].EntireRow.Font.Size := 12;
oSheet.Range['A1',vVarCol].EntireRow.Font.Bold := True;
oSheet.Range['A1',vVarCol].EntireRow.Font.Name := 'Arabic Transparent';
oSheet.Range['A1',vVarCol].Interior.ColorIndex := 15;
oSheet.Range['A1',vVarCol].Interior.Pattern := xlSolid;

                      //  Change the font properties of a row. //
oSheet.Range['A2','A'+IntToStr(vRowNo)].EntireRow.Font.Color := clBlack;
oSheet.Range['A2','A'+IntToStr(vRowNo)].EntireRow.Font.Size := 12;
oSheet.Range['A2','A'+IntToStr(vRowNo)].EntireRow.Font.Name := 'Arabic Transparent';
oSheet.Columns.AutoFit;
Sleep(10);

if FileExists(sFile) then DeleteFile(sFile);
oSheet.SaveAs(sFile);
oSheet.Disconnect;
oSheet.Free;
oWorkbook.Disconnect;
oWorkbook.Free;
oExcel.Quit;
oExcel.Disconnect;
oExcel.Free;
end;