如何将DBGRID数据保存到EXCEL文件中？

Question

如何将DBGRID数据连同列名保存到EXCEL文件中？

Answer 1

//注意：下面的方法必须包含 ComObj, Excel97 单元
  //----------------------------------------------------------- 
  // if toExcel = false, export dbgrid contents to the Clipboard 
  // if toExcel = true, export dbgrid to Microsoft Excel 
  procedure ExportDBGrid(toExcel: Boolean); 
  var 
    bm: TBook; 
    col, row: Integer; 
    sline: String; 
    mem: TMemo; 
    ExcelApp: Variant; 
  begin 
    Screen.Cursor := crHourglass; 
    DBGrid1.DataSource.DataSet.DisableControls; 
    bm := DBGrid1.DataSource.DataSet.GetBook; 
    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(Self); 
    mem.Visible := false; 
    mem.Parent := MainForm; 
    mem.Clear; 
    sline := ''; 
  
    // add the info for the column names 
    for col := 0 to DBGrid1.FieldCount-1 do 
      sline := sline + DBGrid1.Fields[col].DisplayLabel + #9; 
    mem.Lines.Add(sline); 
  
    // get the data into the memo 
    for row := 0 to DBGrid1.DataSource.DataSet.RecordCount-1 do 
    begin 
      sline := ''; 
      for col := 0 to DBGrid1.FieldCount-1 do 
        sline := sline + DBGrid1.Fields[col].AsString + #9; 
      mem.Lines.Add(sline); 
      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); 
    DBGrid1.DataSource.DataSet.GotoBook(bm); 
    DBGrid1.DataSource.DataSet.FreeBook(bm); 
    DBGrid1.DataSource.DataSet.EnableControls; 
    Screen.Cursor := crDefault; 
  end; 

Answer 2

果数据源是QUERY，可以这样：
procedure TForm1.EXCEL2Click(Sender: TObject);
var
  eclApp,WorkBook:Variant;//声明为OLE Automation 对象
  xlsFileName:string;
  i,j,n:integer;
begin
  if SaveDialog1.Execute then
  begin
  xlsFileName:=SaveDialog1.FileName;
  if fileexists(SaveDialog1.FileName) then DeleteFile(SaveDialog1.FileName);
  try
    //创建OLE对象Excel Application与 WorkBook
    eclApp:=CreateOleObject('Excel.Application');
    WorkBook:=CreateOleobject('Excel.Sheet');
  except
    ShowMessage('您的机器里未安装Microsoft Excel。');
    Exit;
  end;
  try    Screen.Cursor:=crHourGlass;
    workBook:=eclApp.workBooks.Add;
    i:=1; //EXECL表行号
    n:=0;//query字段N序号
    Query1.First;
    j:=1;
    for n:=0 to Query1.FieldCount -1 do
        begin
          eclApp.Cells(i,j):=Query1.fields[n].DisplayLabel;
          j:=j+1;
        end;
       i:=2; //EXECL表行号
       n:=0;//query字段N序号
    while not Query1.Eof do begin
          j:=1;//EXECL表列号
      for n:=0 to Query1.FieldCount -1 do
        begin
          eclApp.Cells(i,j):=Query1.fields[n].AsString;
          j:=j+1;
        end;
      Query1.Next;
      i:=i+1;
      end;    WorkBook.SaveAs(xlsFileName);
    Application.MessageBox('操作在没有警告的情况下正常结束！','完成',mb_ok+mb_iconinformation);
    WorkBook.close;
    eclApp.Quit;//退出Excel Application
    eclApp:=Unassigned;//释放VARIANT变量
    Screen.Cursor:=crdefault;
  except
    ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误。');
    WorkBook.close;
    eclApp.Quit;
    //释放VARIANT变量
    eclApp:=Unassigned;
  end;
END;
END;

Answer 3

简单有效的方法：
Procedure TurnToExcel(TmpDBGrid:TDBGrid);
var
  MyExcel: Variant;
  WorkBook: OleVariant;
  WorkSheet: OleVariant;
  i,j:integer;
  xlsfilename :string;
  Savedialog1 :TSaveDialog;
begin
  SaveDialog1 :=TSaveDialog.create(Application);
  SaveDialog1.Filter := 'Excel文件(*.xls)|*.XLS';
  if savedialog1.Execute then
  if savedialog1.FileName <>'' then
  begin
    xlsfilename :=savedialog1.FileName;
  try
   MyExcel:=CreateOleObject('Excel.Application');
   MyExcel.Application.WorkBooks.Add;
   MyExcel.Caption:='将数据导入到EXCEL表中';
   MyExcel.Application.Visible:=false;
   WorkBook:=MyExcel.Application.workbooks[1];
   worksheet:=workbook.worksheets.item[1];
   except
     Application.MessageBox('EXCEL不存在！',App_caption,MB_ICONERROR+MB_OK);
    Savedialog1.Free;
    workBook.Saved := True;
    WorkBook.close;
    MyExcel.Quit;//释放VARIANT变量
    MyExcel:=Unassigned;
   end;
   i:=1;
   Frm_progress :=TFrm_progress.create(Application);
  Try
    with TmpDBGrid.DataSource.DataSet   do
    begin
      Open;
      DisableControls;
      with Frm_progress.pp do
      begin
        minvalue :=0;
        maxvalue :=TmpDBGrid.Columns.Count*recordcount;
        progress :=0;
      end;
      Frm_progress.label1.caption :='正在导出到Excel...';
      Frm_progress.Show;
      Frm_progress.update;
      for j:=0 to TmpDBGrid.Columns.Count-1 do
      begin
        if TmpDBGrid.Columns[j].Visible=true then
         worksheet.cells[1,j+1]:=TmpDBGrid.Columns[j].Title.Caption;
      end;
      First;
      while not Eof do
      begin
        inc(i);
        for j:=0 to TmpDBGrid.Columns.Count-1 do
        begin
          if TmpDBGrid.Columns[j].Visible=true then
          begin
            worksheet.cells[i,j+1].NumberFormatLocal :='@';
            worksheet.cells[i,j+1]:=TmpDBGrid.Columns[j].Field.AsString ;
            Frm_progress.pp.progress :=Frm_progress.pp.progress+1;
          end;
        end;
        next;
      end;
      EnableControls;
    end;
    WorkBook.saveas(XlsFileName);
    Frm_progress.pp.progress :=TmpDBGrid.Columns.Count*TmpDBGrid.DataSource.DataSet.RecordCount;
    Application.MessageBox('导出到Excel成功！',App_caption,MB_ICONINFORMATION+MB_OK);
    Frm_progress.Free;
    MyExcel.Quit;
    MyExcel := Unassigned;
    Savedialog1.Free;
  except
    Application.MessageBox('导出到Excel失败！',App_caption,MB_ICONError+MB_OK);
    workBook.Saved := True;
    WorkBook.close;
    MyExcel.Quit;//释放VARIANT变量
    MyExcel:=Unassigned;
    Frm_progress.Free;
    Savedialog1.Free;
  end;
  end;end;

Answer 4

不好意思，我说的是the third party component

Answer 5

procedure WriteExcel(ds: TQuery; sName: string);
var
  //定义操纵Excel的三个变量
MyExeclApp: TExcelApplication;
  MyExcelWorksheet: TExcelWorksheet;
  MyExcelWorkbook: TExcelWorkbook;
i, j, n: integer;
  filename: string;
begin
  filename := concat( sName, '.xls');
  try
    MyExeclApp := TExcelApplication.Create(Application);
    MyExcelWorksheet := TExcelWorksheet.Create(Application);
    MyExcelWorkbook := TExcelWorkbook.Create(Application);
    MyExeclApp.Connect;
  except
    Application.Messagebox('Excel 没有安装!', 'Hello', MB_ICONERROR + mb_Ok);
    Abort;
  end;
  try
    MyExeclApp.Workbooks.Add(EmptyParam, 0);
    MyExcelWorkbook.ConnectTo(MyExeclApp.Workbooks[1]);
    MyExcelWorksheet.ConnectTo(MyExcelWorkbook.Worksheets[1] as _worksheet);
    ds.First;  //将数据集的记录指针指向首记录
n:=1;
//写入表头，即工资项目的名称
    for j := 0 to ds.Fields.Count - 1 do
      if frmMain.grdMain.Columns[j].Visible = True then
      begin
        MyExcelWorksheet.Cells.item[1, n] := ds.Fields[j].DisplayLabel;
        MyExcelWorksheet.Cells.item[1, n].font.size := '10';
        n:=n+1;
      end;
    //写入数据内容
for i := 2 to ds.RecordCount + 1 do
    begin
      n:=1;
      for j := 0 to ds.Fields.Count - 1 do
        if frmMain.grdMain.Columns[j].Visible = True then
        begin
          MyExcelWorksheet.Cells.item[i, n] :=
              ds.Fields[j].AsString;
          MyExcelWorksheet.Cells.item[i, n].font.size := '10';
          n:=n+1;
        end;
      ds.Next;
      end;
    MyExcelWorksheet.Columns.AutoFit;
    MyExcelWorksheet.SaveAs(filename);
    Application.Messagebox(pchar('数据成功导出' + filename), 'Hello',
      mb_Ok);
  finally
    //释放资源
MyExeclApp.Disconnect;
    MyExeclApp.Quit;
    MyExeclApp.Free;
    MyExcelWorksheet.Free;
    MyExcelWorkbook.Free;
  end;
end;

Answer 6

用DevExpressGrid吧，它带有另存为Excel,Html,XML,Text的方法