求从DataSet导入Excel代码

Question

求从DataSet导入Excel代码,谢谢！·

Answer 1

procedure tform1.ExportDBGrid(toExcel: Boolean);
  var
    bm: TBook;
    col, row: Integer;
    sline: String; 
    mem: TMemo;
    ExcelApp: Variant; 
  begin
    Screen.Cursor := crHourglass;
    form1.DBGrid1.DataSource.DataSet.DisableControls;
    bm := form1.DBGrid1.DataSource.DataSet.GetBook;
    form1.DBGrid1.DataSource.DataSet.First;    // create the Excel object
    if toExcel then
    begin
      ExcelApp := CreateOleObject('Excel.Application');
      ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
      ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Grid Data';
    end;
  
    // First we send the data to a memo
    // works faster than doing it directly to Excel 
    mem := TMemo.Create(nil);
    mem.Visible := false; 
    mem.Parent := form1;
    mem.Clear; 
    sline := '';    // add the info for the column names
    for col := 0 to form1.DBGrid1.FieldCount-1 do
      sline := sline + form1.DBGrid1.Fields[col].DisplayLabel + #9;
    mem.Lines.Add(sline);
  
    // get the data into the memo
    for row := 0 to form1.DBGrid1.DataSource.DataSet.RecordCount-1 do
    begin
      sline := ''; 
      for col := 0 to form1.DBGrid1.FieldCount-1 do
        sline := sline + form1.DBGrid1.Fields[col].AsString + #9;
      mem.Lines.Add(sline);
      form1.DBGrid1.DataSource.DataSet.Next;
    end;    // we copy the data to the clipboard
    mem.SelectAll;
    mem.CopyToClipboard;    // if needed, send it to Excel
    // if not, we already have it in the clipboard
    if toExcel then
    begin
      ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste;
      ExcelApp.Visible := true;
    end;    FreeAndNil(mem);
  //  FreeAndNil(ExcelApp);
    form1.DBGrid1.DataSource.DataSet.GotoBook(bm);
    form1.DBGrid1.DataSource.DataSet.FreeBook(bm);
    form1.DBGrid1.DataSource.DataSet.EnableControls;
    Screen.Cursor := crDefault;
  end;

Answer 2

http://dev.csdn.net/article/53/53450.shtm

Answer 3

unit DBGridToExcel;{***********************************************************************}
 一个例子，希望对你有启发！！~！~  谢谢！！！！
{*                                                                     *}
{* 安装：                                                              *}
{*   把附件保存，然后用Delphi打开这个GridToExcel.Pas文件，             *}
{*   选择Delphi菜单--〉Component-->Install Component，                 *}
{*   然后选择Install即可。安装之后，在控件面板的Samples页面上面，      *}
{*   熟悉之后，你可以试着设置一些复杂的属性，其他的自己摸索吧，        *}
{***********************************************************************}
interfaceuses
  Windows, StdCtrls, ComCtrls, Messages, DBGrids, Graphics, ExtCtrls,
  Forms, DB, ComObj, Controls, SysUtils, Classes;ResourceString
  SPromptExport     = '请等待，正在导出数据……';
  SConnectExcel     = '正在启动Excel，请稍候……';
  SConnectExcelError= '连接Excel失败，可能没有安装Excel,无法导出.';
  SCancel           = '取消(&C)';
  SError            = '错误';
  SConfirm          = '真的要终止数据的导出吗？';
  SCaption          = '确认';
  SGridError        = '没有指定数据集，请指定数据集控件！';type
  TDBGridToExcel = class(TComponent)
  private
    ProgressForm: TForm;
    FShowProgress: Boolean;
    ExcelApp : Variant;
    FTitle: String;
    Quit: Boolean;
    FOnProgress: TNotifyEvent;
    FGrid: TDBGrid;   {The Source Grid}
    ProgressBar: TProgressBar;
    Prompt: TLabel;
    FAutoExit: Boolean;
    FAutoSize: Boolean;
    FDBGrid: TDBGrid;
    procedure SetShowProgress(const Value: Boolean);
    procedure CreateProgressForm;
    procedure ButtonClick(Sender: TObject);
    Function ConnectToExcel: Boolean;
    procedure ExportDBGrid;
    { Private declarations }
  protected
    { Protected declarations }
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy(); override;
    Procedure ExportToExcel;   {Export Grid To Excel}
    { Public declarations }
  published
    { Published declarations }
    property DBGrid: TDBGrid read FDBGrid write FDBGrid;
    property Title: String read FTitle write FTitle;
    property ShowProgress: Boolean read FShowProgress write SetShowProgress;    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Samples', [TDBGridToExcel]);
end;{ TDBGridToExcel }procedure TDBGridToExcel.ButtonClick(Sender: TObject);
begin
  Quit := MessageBox(ProgressForm.Handle, pchar(SConfirm), pchar(SCaption),
    MB_OKCANCEL + MB_ICONINFORMATION) = IDOK;
end;function TDBGridToExcel.ConnectToExcel: Boolean;
begin
  Result := true;
  Try
    ExcelApp := CreateOleObject('Excel.Application');
    ExcelApp.Visible := False;
    if Title<>'' then ExcelApp.Caption := Title;
    ExcelApp.WorkBooks.Add;
  except
    MessageBox(GetActiveWindow,PChar(SConnectExcelError),PChar(SError),Mb_OK+MB_IconError);
    result := false;
  end;
end;constructor TDBGridToExcel.Create(AOwner: TComponent);
begin
  inherited;
  FShowProgress := True;          {Default value was Show the Progress}
  FAutoExit := False;
  FAutoSize := True;
end;

Answer 4

procedure TDBGridToExcel.CreateProgressForm;
var
  Panel  : TPanel;
  Button : TButton;
begin
  if Assigned(ProgressForm) then exit;  {Aready Create?}  ProgressForm := TForm.Create(Owner);
  With ProgressForm do
  begin
    Font.Name := '宋体';
    Font.Size := 10;
    BorderStyle := bsNone;
    Width := 280;
    Height := 120;
    BorderWidth := 1;
    Color := clBackground;
    Position := poOwnerFormCenter;
  end;  Panel := TPanel.Create(ProgressForm);
  with Panel do { Create Panel }
  begin
    Parent := ProgressForm;
    Align := alClient;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    Caption := '';
  end;  Prompt := TLabel.Create(Panel);
  with Prompt do { Create Label }
  begin
    Parent := Panel;
    Left := 20;
    Top := 25;
    Caption := SConnectExcel;
  end;  ProgressBar := TProgressBar.Create(panel);
  with ProgressBar do { Create ProgressBar }
  begin
    Step := 1;
    Parent := Panel;
    Smooth := true;
    Left := 20;
    Top := 50;
    Height := 18;
    Width := 260;
  end;  Button := TButton.Create(Panel);
  with Button do { Create Cancel Button }
  begin
    Parent := Panel;
    Left := 115;
    Top := 80;
    Caption := SCancel;
    OnClick := ButtonClick;
  end;  ProgressForm.Show;
  ProgressForm.Update;
end;destructor TDBGridToExcel.Destroy;
begin  inherited;
end;procedure TDBGridToExcel.ExportDBGrid;
var
  Data   : TDataSet;
  ADBGrid: TDBGrid;
  i, j   : integer;
  CurrentPoint : Pointer;
  OldBeforeScroll, OldAfterScroll: TDataSetNotifyEvent;
begin
  Screen.Cursor := crHourGlass;
  try
    try
      TForm(Owner).Enabled := False;
      ExcelApp.DisplayAlerts := false;
      ExcelApp.ScreenUpdating := false;
      Quit := false;      if ShowProgress then Prompt.Caption := SPromptExport;
      ADBGrid := DBGrid;
      Data := ADBGrid.DataSource.DataSet;
      with ADBGrid do { Insert Table Header }
        for i := 1 to Columns.Count do
          if Columns[i - 1].Visible then
            ExcelApp.Cells[1,i].Value :=Columns[i - 1].Title.Caption;      CurrentPoint := Data.GetBook;  {Save Current Position}
      OldBeforeScroll := Data.BeforeScroll; { Save Old Before Scroll Event handle }
      OldAfterScroll := Data.AfterScroll; { Save Old After Scroll Event Handle }
      Data.DisableControls; { Disable Control }
      Data.BeforeScroll := nil;
      Data.AfterScroll := nil;
  
      if ShowProgress then ProgressBar.Max := Data.RecordCount;
      i := 2;
      Data.First;
      while not Data.Eof do  { Process All record }
      begin
        with ADBGrid do { Process one record }
          for j := 1 to Columns.Count do
            if Columns[j - 1].Visible then
              ExcelApp.Cells[i,j].Value := Columns[j - 1].Field.DisplayText;
        Inc(i);
        Data.Next;
        if Assigned(FOnProgress) then FOnProgress(Self);
        if ShowProgress then { Update Progress UI }
        begin
          ProgressBar.StepIt;
          Application.ProcessMessages;
          if Quit then exit;
        end;
      end;
    except
      MessageBox(GetActiveWindow,PChar(SConnectExcelError),Pchar(SError),MB_OK+MB_ICONERROR);
    end;
    ExcelApp.Visible := False;
    TForm(Owner).Enabled := True;
    Screen.Cursor := crDefault;
    if ShowProgress then FreeAndNil(ProgressForm); { Free Progress Form }
    ExcelApp.DisplayAlerts := True;
    ExcelApp.ScreenUpdating := True;
  finally
    Data.BeforeScroll := OldBeforeScroll; { Restore Old Event Handle }
    Data.AfterScroll := OldAfterScroll;
    Data.GotoBook(CurrentPoint);
    Data.FreeBook(CurrentPoint);
    Data.EnableControls;
    Screen.Cursor := crDefault;
  end;
end;procedure TDBGridToExcel.ExportToExcel;
begin
  if DBGrid= nil then raise Exception.Create(SGridError); {No DataSource, then Error}
  if ShowProgress then CreateProgressForm; {Whether or not Show the ProgressForm}
  if not ConnectToExcel then { Exit when error occer }
  begin
    if ShowProgress then  FreeAndNil(ProgressForm);   {release form}
    exit;
  end;
  ExportDBGrid;  {begin Export Data}
end;procedure TDBGridToExcel.SetShowProgress(const Value: Boolean);
begin
  FShowProgress := Value;
end;
end. 

Answer 5

function TFrm_student.S_IsFileInUse(FileName : string ) : boolean;
var
  HFileRes : HFILE;
begin
  Result := false;
  if not FileExists(FileName) then
    exit;
  HFileRes := CreateFile(pchar(FileName), GENERIC_READ or GENERIC_WRITE,0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;
  procedure TFrm_student.suiButton11Click(Sender: TObject);
Var
  ExcelApp:Variant;
  SaveDialog1: TSaveDialog;
  i,j,row,column:integer;
begin
  //dm.Apps.Get_Seek_Result(querystr,1);
  with dm.ClientDataSet1 do begin
  querycount:=RecordCount;
   close;open;
  if dm.ClientDataSet1.IsEmpty then
  begin
    ShowMessage('没有数据需要存盘！');//test
    Exit;
  end;
  SaveDialog1:= TSaveDialog.Create(nil);
  SaveDialog1.Filter := 'Excel 文件 (*.xls)|*.xls';
  SaveDialog1.Title:='确定另存为excel的文件名';
  if savedialog1.Execute Then
    begin
      while S_IsFileInUse(savedialog1.FileName) do
      begin
        case Application.MessageBox(PChar('无法存盘，'+string(ExtractFileName(savedialog1.FileName))+'正在使用中'), '请确认', MB_ICONQuestion+MB_ABORTRETRYIGNORE+MB_DEFBUTTON2) of
          IDAbort:
            begin
              SaveDialog1.Free;
              Exit;
            end;
          IDRetry:
            begin
              continue;
            end;
          IDIgnore:
            begin
              if Not savedialog1.Execute then break;
            end;
        end;
      end;
    end
  else
    begin
      SaveDialog1.Free;
      exit;
    end;//if
   try
    ExcelApp:=CreateOleObject('Excel.Application');//首先创建 Excel 对象，使用ComObj
   except
    Application.Messagebox('Excel没有安装!','Hello',MB_ICONERROR + mb_Ok);
    Abort;
   end;//end try
  try
    ExcelApp.Visible := False;//显示当前窗口
    ExcelApp.Caption := '应用程序调用 Microsoft Excel';//更改 Excel 标题栏
    ExcelApp.WorkBooks.Add;//添加新工作簿：
    ExcelApp.WorkSheets[ 'Sheet1' ].Activate;//设置第1个工作表为活动工作表
    ExcelApp.ActiveSheet.Rows[1].Font.Size:=10;
    ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
    row:=1;
    column:=1;
    for j:= 0 to dm.ClientDataSet1.FieldCount-1 do
      begin
        ExcelApp.Cells[row,column].Value:=dm.ClientDataSet1.Fields[j].DisplayLabel;
        column:=column+1;
      end;
    row:=2;
    while (Not dm.ClientDataSet1.Eof) and (Not dm.ClientDataSet1.IsEmpty) do
    begin
      column:=1;
      for i:=1 to dm.ClientDataSet1.FieldCount do
        begin
          ExcelApp.Cells[row,column].Value:=dm.ClientDataSet1.fields[i-1].AsString;
          column:=column+1;
        end;
      dm.ClientDataSet1.Next;
      row:=row+1;
    end;
    if Not S_IsFileInUse(savedialog1.FileName) then
      try
        ExcelApp.ActiveWorkBook.SaveAs(savedialog1.filename);
      except
        SaveDialog1.Free;
        ExcelApp.WorkBooks.Close;
        ExcelApp.Quit;
        ExcelApp:= Unassigned;
        exit;
      end;
    SaveDialog1.Free;
    ExcelApp.WorkBooks.Close;
    ExcelApp.Quit;
    ExcelApp:= Unassigned;
    Application.MessageBox('Excel文件导出成功!','成功',MB_OK);
  except
    SaveDialog1.Free;
    ExcelApp:= Unassigned;
  end;
  end;
end;你自己改一下就可以了