تصدير بيانات dbgrid الى excel

[appakar]

السلام عليكم
جربت هذا الكود في button لكن ظهر رسالة خطأ مفادها

Unit1.pas(164): E2081 Affectation à la variable de boucle FOR 'i'

هل من حل؟؟؟

كود :

procedure TForm1.Button5Click(Sender: TObject); var xlapp,shet : OleVariant; i,i1,j : integer; s: string; begin xlapp := createOleObject ('Excel.Application'); shet := createOleObject('Excel.sheet'); shet := xlapp.workbooks.add; i1 := 0; for i := 0 to dbgrid1.Columns.Count-1 do   begin     if dbgrid1.Columns[i].Visible = true then     begin       xlapp.cells(1,i1+1):=dbgrid1.Columns[i].Title.Caption;       inc(i1);     end;     dbgrid1.DataSource.DataSet.First;     j:=2;     while not dbgrid1.DataSource.DataSet.Eof do     begin       i1 := 0;      //--------هنا الخطأ------------------// for i := 0 to dbgrid1.Columns.Count-1 do       begin         if dbgrid1.Columns[i].Visible = true then         begin           if dbgrid1.Columns[i].FieldName = 'NumCert' then           begin             xlapp.cells(j,i1+1):=j-1;           end           else           begin             xlapp.cells(j,i1+1):=dbgrid1.Fields[i].AsString;           end;           inc(i1);         end;       end;       inc(j);       dbgrid1.DataSource.DataSet.Next;     end;     s:= extractfilepath(application.ExeName)+'1.xlsx';     shet.saveas( s);     shet.close;   end; end;

[nawfel201]

procedure TfrmMain.BitBtn1Click(Sender: TObject);

begin

if SaveDialog1.Execute then

begin

  ExportTableToExcel(FDQuery1,SaveDialog1.FileName);

end;

end;

procedure TfrmMain.ExportTableToExcel(Tablex:TFDQuery;sFiletring);

var

//Declarations

ExcelApplication : variant;

Sheet : variant;

column, row ,rowsno: integer;

FormatFloatY:WideString;

ValXX:WideString;

begin

Cursor:=crHourGlass;

try  //Try to create Excel application

  begin

  ExcelApplication := CreateOleObject('Excel.Application');

  ExcelApplication.Visible := true;  //let's make visible

  end;

except

//If failed then show warning

  Showmessage('Cannot create an Excel file,'

  +'make sure that MS Excel is installed on your system');

  Application.Terminate;

end;

rowsno:=Tablex.RecordCount;  //records number in a table

Tablex.RecNo:=1; //set table to first record

ExcelApplication.WorkBooks.Add(-4167);  //Add excel workbook

ExcelApplication.WorkBooks[1].Worksheets[1].Name := 'قائمة الاساتذة';

Sheet := ExcelApplication.WorkBooks[1].WorkSheets['قائمة الاساتذة'];

//Format cells in excel sheet

Sheet.Range['A1:F'+IntToStr(rowsno+1)].Borders.LineStyle := 7;

Sheet.Range['A1:F'+IntToStr(rowsno+1)].Borders.color := clBlack;

Sheet.Range['A1:A'+IntToStr(rowsno+1)].HorizontalAlignment := xlCenter;

      //colors of cells in first line

Sheet.Cells[1,1].Interior.Color := clMoneyGreen;

Sheet.Cells[1,2].Interior.Color := clMoneyGreen;

Sheet.Cells[1,3].Interior.Color := clMoneyGreen;

Sheet.Cells[1,4].Interior.Color := clMoneyGreen;

Sheet.Cells[1,5].Interior.Color := clMoneyGreen;

Sheet.Cells[1,6].Interior.Color := clMoneyGreen;

                          //widths of columns

Sheet.Columns[1].ColumnWidth := 10;

Sheet.Columns[2].ColumnWidth := 30;

Sheet.Columns[3].ColumnWidth := 12;

Sheet.Columns[4].ColumnWidth := 25;

Sheet.Columns[5].ColumnWidth := 12;

Sheet.Columns[6].ColumnWidth := 12;

            //captions/text of cells

Sheet.Cells[1,1] := 'الرفم';

Sheet.Cells[1,2] := 'الاسم واللقب';

Sheet.Cells[1,3] := 'تاريخ الميلاد';

Sheet.Cells[1,4] := 'أسم المدرسة';

Sheet.Cells[1,5] := 'بداية التربص';

Sheet.Cells[1,6] := 'الحالة';

  //set progressbar max value = teble records count

ProgressBar1.max:=Tablex.RecordCount;

ProgressBar1.position:=0;  //set position to 0=start

//now copy from table to excel cells

for row := 1 to Tablex.RecordCount do

begin

Sheet.Cells[row+1,1] := Tablex.Fields[0].AsString; //row+1 = move to the next line

//in column one

Sheet.Cells[row+1,2] :=Tablex.Fields[1].AsString;

//row+1 = move to the next line

//in column two

Sheet.Cells[row+1,3] := Tablex.Fields[2].AsString;

//row+1 = move to the next line

//in column three

Sheet.Cells[row+1,4] := Tablex.Fields[3].AsString;

//row+1 = move to the next line

//in column three

Sheet.Cells[row+1,5] := Tablex.Fields[4].AsString;

//row+1 = move to the next line

//in column three

Sheet.Cells[row+1,6] := Tablex.Fields[5].AsString;

//row+1 = move to the next line

//in column three

ProgressBar1.position:=row;//set progress bar position

Tablex.Next;  //go to the next record in a table

end;

Screen.Cursor:=crDefault;  //set default cursor

ProgressBar1.position:=0; //it is done , set PB to the begining

DeleteFile(sFile);  //

Sheet.SaveAs(sFile);  //Save excel file

Screen.Cursor:=crDefault;  //set default cursor

{ ExcelApplication.Quit; //Quit excel

  ExcelApplication := Unassigned;  //to be sure that no hidden excel in memory

    Sheet := Unassigned; }

  //let's close manually

//let's test

//a bit slow while screen capturing

end;

[bouh25]

حسب مراجعتي للكود فانك قمت بارسال جزء من الكود ولا يعمل للافادة ارسل كود كاملا
مثلا البوسجر ExportTableToExcel غير موجود بالكود sFile غير معرف .....

[nawfel201]

حسب مراجعتي للكود فانك قمت بارسال جزء من الكود ولا يعمل للافادة ارسل كود كاملا
مثلا البوسجر ExportTableToExcel غير موجود بالكود sFile غير معرف .....

للعلم ان الكود الذي قمت بوضعه كامل ووضعت لك في المرفقات كود سورس للبرنامج

[appakar]

ملف excel المستخرج فارغ

[ghostdz]

السلام عليكم 
جرب الكود التالي هو عبارة عن كود appakar مع تغييرات عليه

كود :

procedure TForm2.ExportDbGridToXls(const ADbGrid: TDbGrid; const FileName: string); var   XlApp, Sheet: OleVariant;   I, Row,   ColCount: Integer;   DataSet: TDataSet; begin   XlApp := createOleObject ('Excel.Application');   Sheet := xlapp.workbooks.add;   DataSet := ADbGrid.DataSource.DataSet;   ColCount := ADbGrid.Columns.Count;   for I := 0 to  ColCount - 1 do     if ADbGrid.Columns[I].Visible then       XlApp.Cells(1, I + 1) := ADbGrid.Columns[I].Title.Caption;   Row := 2;   DataSet.DisableControls;   try     DataSet.First;     while not DataSet.Eof do     begin       for I := 0 to ColCount - 1 do         if ADbGrid.Columns[I].Visible then           XlApp.Cells(Row, I + 1):= ADbGrid.Fields[I].AsString;       Row := Row + 1;       DataSet.Next;     end;   finally     DataSet.EnableControls;   end;   Sheet.SaveAs(FileName);   Sheet.Close; end;

[أبو معاذ]

السلام عليكم.هل ألقيت نظرة على هذا الموضوع ؟

http://delphi4arab.net/forum/showthread.php?tid=7701