نقل البيانات من dbgrid إلى Excel - نسخة قابلة للطباعة

كود :

var
  Form1: TForm1;
  anExcelFileName, MyFile: String;
  a:array [1..26]of string[1]=('A','B','C','D','E','F','G','H','I','J','K','L',
                      'M','N','O','P','Q','R','S','T','u','V','W','X','Y','Z');
implementation

{$R *.dfm}
var
  OleApplication :variant;
  OleWorkBook    :variant;
  XLApp: Variant;

procedure TForm1.btn1Click(Sender: TObject);
var
  i: integer;
strT: string;
slst: TStringList;
Save_Cursor:TCursor;
XLApp: Variant;
Sheet: Variant;
iCol,jRow : Integer;
v : Variant;
  
begin
Save_Cursor := Screen.Cursor;
Screen.Cursor := crHourglass;
try
// Create a worksheet in a new instance of excel and get a handle to
//it to use below
XLApp := CreateOLEObject('Excel.Application');
XLApp.Visible := True;
XLApp.Workbooks.Add[XLWBatWorksheet];
XLApp.Workbooks[1].Worksheets[1].Name :='essai_excel';


// Set the header line (jRow) and populate based on dataset
jRow := 1;
for iCol := 1 to qry1.FieldCount do
begin
v := qry1.Fields[iCol-1].FieldName; // we need this
//intermediate variant because of weird exceptions without...
Sheet.Cells[jRow, iCol] := v;
qry1.Next;
end;

// Move to the next row (Inc(jRow)) and populate data in row first
//order
qry1.First;
Inc(jRow);
while not qry1.EOF do
begin
for iCol := 1 to qry1.FieldCount do
begin
v := qry1.Fields[iCol-1].Value;
Sheet.Cells[jRow, iCol] := v;
end;
Inc(jRow); // move the next row on the sheet and the dataset
qry1.Next;
end;

// set the first line to bold
XLApp.Workbooks[1].WorkSheets['Delphi Data'].Rows.Item[iCol].Font.Bold
:= True;

// auto size the columns
for iCol := 1 to qry1.FieldCount do
XLApp.Workbooks[1].WorkSheets['Delphi Data'].Columns[iCol].EntireColumn.Autofit;
finally
Screen.Cursor := Save_Cursor;
end;
end;


procedure TForm1.btn2Click(Sender: TObject);
var
  x,i,iCol,jRow:integer;
  ExcelApp, Workbook: OleVariant;
  anExcelFileName: String;
  v, Sheet : Variant;

begin
  try
    ExcelApp := CreateOleObject('Excel.Application');
    anExcelFileName := 'D:\essai\models_excel\model.xlt';

    Workbook := ExcelApp.Workbooks.Open(anExcelFileName);
    ExcelApp.Visible := True;

    qry1.First;
      while not qry1.EOF do
      begin
          qry1.First;
            x:=1;
          while not qry1.Eof do
          begin
              for i:=0 to dbgrd1.FieldCount-1 do
                  begin
                    Workbook.Sheets[1].Range['A7'].Value := form1.dbedtCODE_F.Text ;
                    Workbook.Sheets[1].Range['B7'].Value := form1.dbedtNom_F.Text  ;
                    Workbook.Sheets[1].Range['C7'].Value := form1.dbedtpere.Text  ;
                    Workbook.Sheets[1].Range['D7'].Value := form1.dbedtmere.Text  ;
                    Workbook.Sheets[1].Range['E7'].Value := form1.dbedtAdr_Fam.Text  ;
                    Workbook.Sheets[1].Range['F7'].Value := form1.dbedtN_tel.Text  ;
                    Workbook.Sheets[1].Range['G7'].Value := form1.dbedtNbre_enf.Text  ;
                    Workbook.Sheets[1].Range['H7'].Value := form1.dbedtNote_dz.Text  ;
                  end;
          end;
              x:=1;
              v := qry1.Fields[iCol-1].Value;
              Sheet.Cells[jRow, iCol] := v;
              end;
                Inc(jRow); // move the next row on the sheet and the dataset
              x:=x+1;
                qry1.Next;
  except
    on E: Exception do
      showMessage('Error on something: ' + E.Message);

  end;

    end;

كود :

procedure ExportToCSV(const aGrid : TDBGrid; const FileName : String);
Var
  I, J : Integer;
  SavePlace : TBookmark;
  Table : TStrings;
  HeadTable : String;
  LineTable : String;
  First : Boolean;
Begin

  HeadTable := '';
  LineTable := '';
  Table := TStringList.Create;
  First := True;

  Try
    For I := 0 To Pred(aGrid.Columns.Count) Do
      If aGrid.Columns[I].Visible Then
        If First Then
        Begin
          HeadTable := HeadTable + aGrid.Columns[i].Title.Caption + ',';
          First := False;
        End
        Else
        begin
          HeadTable := HeadTable + aGrid.Columns[i].Title.Caption + ',';
        end;

    Delete(HeadTable, Length(HeadTable), 1);
    Table.Add(HeadTable);
    First := True;

    // with selection of rows
    If aGrid.SelectedRows.Count > 0 Then
    Begin
      For i := 0 To aGrid.SelectedRows.Count - 1 Do
      Begin
        aGrid.DataSource.Dataset.GotoBookmark(pointer(aGrid.SelectedRows.Items[i]));
        For j := 0 To aGrid.Columns.Count - 1 Do
          If aGrid.Columns[J].Visible Then
            If First Then
            Begin
              lineTable := lineTable + aGrid.Fields[J].AsString;
              First := False;
            End
            Else
              lineTable := lineTable + ',' + aGrid.Fields[J].AsString;

        Delete(LineTable, Length(LineTable), 1);  // Remove the superfluous trailing comma
        Table.Add(LineTable);
        LineTable := '';
        First := True;
      End;
    End
    Else
      //no selection
    Begin
      SavePlace := aGrid.DataSource.Dataset.GetBookmark;
      aGrid.DataSource.Dataset.First;

      Try
        While Not aGrid.DataSource.Dataset.Eof Do
        Begin
          For I := 0 To aGrid.Columns.Count - 1 Do
            If aGrid.Columns[I].Visible Then
              If First Then
              Begin
                lineTable := lineTable + aGrid.Fields[I].AsString;
                First := False;
              End
              Else
                lineTable := lineTable + ',' + aGrid.Fields[I].AsString;


          Delete(LineTable, Length(LineTable), 1);  // Remove the superfluous trailing comma
          Table.Add(LineTable);
          LineTable := '';
          aGrid.DataSource.Dataset.Next;
          First := True;
        End;

        aGrid.DataSource.Dataset.GotoBookmark(SavePlace);
      Finally
        aGrid.DataSource.Dataset.FreeBookmark(SavePlace);
      End;
    End;
    Table.SaveToFile(FileName,Tencoding.UTF8);
  Finally
    Table.Free;
  End;


        end;