procedure لتصدير Dataset نحو Excel

[أبو معاذ]

طريقة أخرى للحفظ بصيغة Excel أو Word

كود :

uses  ComObj, ActiveX; procedure SaveToExcelFile(DBGridName: TDBGrid); var  XLApp: variant;  Sheet: variant;  WordApp, WordDoc, WordParagraph, WordRange, WordTable: variant;  I, J:  integer;  SaveDialog: TSaveDialog;  pBookMark: TBookMark;  StrSaveFile: string;  IntFileType: integer;  SltRec, SltCol: integer;  ColIndex, RowIndex: integer; begin  if DBGridName.DataSource.DataSet.IsEmpty then  begin    MessageBox(Application.Handle, 'There is no data to save!', 'Warning', MB_OK);    Abort;  end;  SaveDialog := TSaveDialog.Create(nil);  SaveDialog.Filter := 'Microsoft Excel files |*.xls|Microsoft Word Document |*.doc ';  SaveDialog.Execute;  IntFileType := SaveDialog.FilterIndex;  StrSaveFile := SaveDialog.FileName;  if Length(StrSaveFile) = 0 then    Exit;  try    Screen.Cursor := crHourGlass;    case IntFileType of      1:      begin        try          XLApp := CreateOleObject('Excel.Application');          XLApp.WorkBooks.Add(-4167);          XLApp.WorkBooks[1].WorkSheets[1].Name := 'Export Data';          Sheet := XLApp.WorkBooks[1].WorkSheets['Export data'];          J := 1;        except          MessageBox(GetActiveWindow,            'Can''t call Microsoft Excel!' + chr(13) + chr(10) +            'Please check whether the installed Mircorsoft Excel.',            '', MB_OK + MB_ICONINFORMATION);          Exit;        end;        with  DBGridName.DataSource.DataSet do        begin          pBookMark := GetBookmark;          DisableControls;          for  I := 0 to DBGridName.Columns.Count - 1 do          begin            if not DBGridName.Columns[I].Visible then              Continue;            Sheet.Cells[J, I + 1] := dbgridname.Columns[I].Title.Caption;          end;          Inc(J);          First;          while not EOF do          begin            for  I := 0 to DBGridName.Columns.Count - 1 do            begin              if not DBGridName.Columns[I].Visible then                Continue;              Sheet.Cells[J, I + 1] :=                Trim(DBGridName.DataSource.DataSet.FieldByName(                DBGridName.Columns[i].FieldName).AsString);            end;            Inc(J);            Next;          end;          GotoBookmark(pBookMark);          FreeBookmark(pBookMark);          EnableControls;        end;        XLApp.activeworkbook.saveas(StrSaveFile);        Application.ProcessMessages;        XLApp.Application.Quit;      end;      2:      begin        try          if VarIsEmpty(WordApp) then            WordApp := CreateOleObject('word.Application');          WordDoc := WordApp.Documents.Add;          WordParagraph := WordApp.ActiveDocument.Paragraphs.Add;          WordRange := WordParagraph.Range;          WordRange.Font.Size := 15;          WordRange.Font.Name := '?? ';        except          MessageBox(GetActiveWindow,            'can not call Mircorsoft Word!' + chr(13) + chr(10) +            'Please check whether the installed Mircorsoft Word.',            'Tips', MB_OK + MB_ICONINFORMATION);          Abort;        end;        SltRec := DBGridName.SelectedRows.Count;        SltCol := 0;        for  J := 0 to DBGridName.Columns.Count - 1 do        begin          if DBGridName.Columns[J].Visible then            SltCol := SltCol + 1;        end;        WordRange := WordApp.ActiveDocument.Content;        WordTable := WordApp.ActiveDocument.Tables.Add(          WordRange, SltRec + 1, SltCol);        ColIndex  := 1;        for  J := 0 to DBGridName.Columns.Count - 1 do        begin          if (not DBGridName.Columns[J].Visible) then            Continue;          WordTable.Cell(1, ColIndex).Range.InsertAfter(            DBGridName.Columns[J].Title.Caption);          ColIndex := ColIndex + 1;        end;        RowIndex := 2;        ColIndex := 1;        with  DBGridName.DataSource.DataSet do        begin          First;          pBookMark := GetBookmark;          DisableControls;          while not EOF do          begin            for  j := 0 to DBGridName.Columns.Count - 1 do            begin              if (DBGridName.Columns[j].Visible <> False) then              begin                WordTable.Cell(RowIndex, ColIndex).Range.InsertAfter                (DBGridName.DataSource.DataSet.FieldByName(                  DBGridName.Columns[j].FieldName).AsString);                ColIndex := ColIndex + 1;              end;            end;            RowIndex := RowIndex + 1;            ColIndex := 1;            Next;          end;          GotoBookmark(pBookMark);          FreeBookmark(pBookMark);          EnableControls;        end;        WordApp.ActiveDocument.SaveAs(StrSaveFile);        Application.ProcessMessages;        WordApp.Application.Quit;      end;    end;  finally    SaveDialog.Free;    Screen.Cursor := crDefault;  end; end;

هناك مكونات تجارية تقوم بهذا الغرض، منها:

كود :

http://www.scalabium.com/sme/

رائعة ،
جزاك الله خيرا.