如何将一个表或dbgrid中的数据导出到excel表中,高手来看看

Question

我用的是ms sql server2000,请教如何将一个表或过滤出来的数据导出到excel表中?

Answer 1

procedure TDataModule_public.WriteExcel(AdsData: TTable; sName, Title: string);
var
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  i, j: integer;
  filename: string;
begin
  filename := sName;
  try
    ExcelApplication1 := TExcelApplication.Create(Application);
    ExcelWorksheet1 := TExcelWorksheet.Create(Application);
    ExcelWorkbook1 := TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
  except
    Application.Messagebox('Excel 没有安装!', 'Hello', MB_ICONERROR + mb_Ok);
    Abort;
  end;
  try
    ExcelApplication1.Workbooks.Add(EmptyParam, 0);
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
    AdsData.First;
    for j := 0 to AdsData.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[3, j + 1] := AdsData.Fields[j].DisplayLabel;
        ExcelWorksheet1.Cells.item[3, j + 1].font.size := '10';
      end;
    for i := 4 to AdsData.RecordCount + 3 do
      begin
        for j := 0 to AdsData.Fields.Count - 1 do
          begin
            ExcelWorksheet1.Cells.item[i, j + 1] :=
                AdsData.Fields[j].Asstring;
            ExcelWorksheet1.Cells.item[i, j + 1].font.size := '10';
          end;
        AdsData.Next;
      end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size := '14';
    ExcelWorksheet1.SaveAs(filename);
    Application.Messagebox(pchar('数据成功导出' + filename), 'Hello',
      mb_Ok);
  finally
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  end;
end;

Answer 2

我用的是dephi 6.0,使用ado组件连接数据库,我将ttable改为tadotable,系统编译时提示"无法识别TExcelApplication等",请问如何处理.

Answer 3

根据DBGRid导出到Excel
Procedure TurnToExcel(TmpDBGrid:TDBGrid);
var
  MyExcel: Variant;
  WorkBook: OleVariant;
  WorkSheet: OleVariant;
  i,j:integer;
  xlsfilename :string;
  Savedialog1 :TSaveDialog;
begin
  if Application.MessageBox('确认导出到Excel？',App_caption,MB_ICONQUESTION+MB_YESNO)=mrno then
     Abort;
  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_system_progress :=TFrm_system_progress.create(Application);
  Try
    with TmpDBGrid.DataSource.DataSet   do
    begin
      Open;
      DisableControls;
      with Frm_system_progress.ProgressBar_temp do
      begin
        min :=0;
        max :=TmpDBGrid.Columns.Count*recordcount;
        Position :=0;
      end;
      Frm_system_progress.label_progress.caption :='正在导出到Excel...';
      Frm_system_progress.Show;
      Frm_system_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_system_progress.ProgressBar_temp.StepIt;
          end;
        end;
        next;
      end;
      EnableControls;
    end;
    WorkBook.saveas(XlsFileName);
    Frm_system_progress.ProgressBar_temp.position :=TmpDBGrid.Columns.Count*TmpDBGrid.DataSource.DataSet.RecordCount;
    Application.MessageBox('导出到Excel成功！',App_caption,MB_ICONINFORMATION+MB_OK);
    Frm_system_progress.Free;
    MyExcel.Quit;
    MyExcel := Unassigned;
    Savedialog1.Free;
  except
    Application.MessageBox('导出到Excel失败！',App_caption,MB_ICONWARNING+MB_OK);
    workBook.Saved := True;
    WorkBook.close;
    MyExcel.Quit;//释放VARIANT变量
    MyExcel:=Unassigned;
    Frm_system_progress.Free;
    Savedialog1.Free;
  end;
  end;end;

Answer 4

多谢回复高手.特别向things(平)致敬!
根据高手指点,我最终实现了向excel导出数据(从adoquery中接收数据进行导出):
注意: uses 中一定要加comobj;uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DB, ADODB, ComCtrls, ToolWin, ExtCtrls, DBCtrls,
  StdCtrls, Buttons, Grids, DBGrids,comobj;procedure tmainfrm.writexls(datasour:tadoquery;xlsname,xlstitle,xlsdate:string);
var
  xlsapp,xlssheet:variant;
  xlsfilename,xlsfiletitle,xlsfiledate:string;
  i,j:integer;
begin
  xlsfilename:=xlsname;
  xlsfiletitle:=xlstitle;
  xlsfiledate:=xlsdate;
  try
    xlsapp:=createoleobject('excel.application');
    xlssheet:=createoleobject('excel.sheet');
  except
    showmessage('本机没有安装Microsoft excel!');
    exit;
  end;
  mainstatb.Panels[0].Text :='正在导出数据到xls文件';
  mainstatb.Refresh;
  try
    xlssheet:=xlsapp.workbooks.add;
    xlsapp.cells(1,1):=xlsfiletitle;
    xlsapp.cells(2,1):=xlsfiledate;
    if not datasour.Active then
      begin
        datasour.Active :=true;
      end;
    Datasour.First;
    for j := 0 to datasour.Fields.Count - 1 do
      begin
        xlsapp.Cells.item[3, j + 1] := datasour.Fields[j].DisplayLabel;
        xlsapp.Cells.item[3, j + 1].font.size := '10';
      end;
    for i := 4 to datasour.RecordCount + 3 do
      begin
        for j := 0 to datasour.Fields.Count - 1 do
          begin
            xlsapp.Cells.item[i, j + 1] :=datasour.Fields[j].Asstring;
            xlsapp.Cells.item[i, j + 1].font.size := '10';
          end;
        datasour.Next;
      end;
    xlsapp.Columns.AutoFit;
    xlssheet.saveas(xlsname);
    xlssheet.close;
    xlsapp.quit;
    xlsapp:=unassigned;
    mainstatb.Panels[0].Text :='已成功导出数据到xls文件!';
    mainstatb.Refresh;
    showmessage('数据已保存为: '+xlsname);
  except
    mainstatb.Panels[0].Text :='导出XLS文件失败!';
    mainstatb.Refresh;
    showmessage('数据转换出错！');
    xlssheet.close;
    xlsapp.quit;
    xlsapp:=unassigned;
  end;
end;

Answer 5

var
  MsExcel:Variant;
  MsExcelWorkBook:Variant;
  MsExcelWorkSheet:Variant;
  Template:OleVariant;
  excelchar:String;
  av:Variant;
  cfornum,ctonum,rnum:Integer;
begin
  if IfMsExcel then MsExcel.Quit;
  Template:=1;
  try
    MsExcel:=CreateOleObject('Excel.Application');
    MsExcelWorkBook:=MsExcel.WorkBooks.Add(Template);
    MsExcelWorkSheet:=MsExcelWorkBook.worksheets.item[1];
    MsExcelWorkSheet.Columns.Font.Name:='宋体';
    MsExcelWorkSheet.Columns.Font.Size:=9;
    IfMsExcel:=True;
  except
    Application.MessageBox('没有安装Excel！','提示信息',0+mb_iconwarning);
    Exit;
  end;
  MsExcel.caption:=Caption;
  //MsExcel.Visible:=True;
  ctonum:=DBG_employee.Columns.Count;
  av:=VarArrayCreate([1,Query_E_employee.RecordCount+2,1,ctonum],varVariant);
  Query_E_employee.DisableControls;
  //抬头
  av[1,1]:=Caption;
  //赋值字段名
  for cfornum:=1 to ctonum do begin
    av[2,cfornum]:=DBG_employee.Columns.Items[cfornum-1].Title.Caption;
  end;
  //赋值工资数据
  with Query_E_employee do begin
    First;
    rnum:=3;
    while not eof do begin
      for cfornum:=1 to ctonum do begin
        av[rnum,cfornum]:=DBG_employee.Columns.Items[cfornum-1].Field.AsString;
      end;
      Inc(rnum);
      Next;
    end;
  end;
  excelchar:=Char((ctonum-1) div 26 + 64)+char((ctonum-1) mod 26 + 65);
  if excelchar[1]=char(64) then delete(excelchar,1,1);
  //赋值标题
  //MsExcelWorkSheet.PageSetup.PaperSize:=xlPaperA3;
  MsExcelWorkSheet.Range['A1',excelchar+'1'].VerticalAlignment:=xlVAlignCenter;{居中}
  MsExcelWorkSheet.Range['A1',excelchar+'1'].HorizontalAlignment:=xlHAlignCenter;
  MsExcelWorkSheet.Range['A1',excelchar+'1'].Font.Bold:=True;
  MsExcelWorkSheet.Range['A1',excelchar+'1'].Font.Name:='宋体';
  MsExcelWorkSheet.Range['A1',excelchar+'1'].Font.Size:=18;
  MsExcelWorkSheet.Range['A1',excelchar+'1'].Merge(False);
  //赋值内容
  excelchar:=excelchar+Trim(IntToStr(rnum-1));
  MsExcelWorkSheet.Range['A1',excelchar].Value:=av;
  //划线加边框
  MsExcelWorkSheet.Range['A2',excelchar].Borders.LineStyle:=xlContinuous;
  MsExcel.Visible:=True;
  Query_E_employee.EnableControls;
end;