请问各位高手:如何将DBGrid 的 数据 转到 Excel2000 中,请给一个具体的例程......

Question

我建立一个查询,将查询的结果用DBGrid来显示,那么我如何才能够将DBGrid中的内容传到Excel2000 ?请各位高手给出一个具体的实现方案......

Answer 1

转载:单元：uexceltools
作者：  bear
功能：保存数据集，如ttable,tquery,tclientdataset等为excel文件，
          包含标题，可以只将一部分字段导出
           这一点通过设置dataset中要不导出字段的tag值大于某一个值来处理
原理：调用 microsoft excel ole对象
调用方式：  
                 function datasettoexcel(
                     dataset:tdataset;fieldtagmax:integer;
                      visible:boolean;excelfilename:string=''): boolean;
--------------------------------------------------------------------------------------------------}unit uexceltools;interfaceuses
  classes, comctrls, stdctrls, windows, dialogs, controls, sysutils,
  db,forms,dbclient,comobj;//把数据集导入excelsheet的核心函数
function datasettoexcelsheet
            (
             dataset     :tdataset;
             fieldtagmax :integer;   // 字段的tag值如果大于这个值，就不导出到excel
             sheet       :olevariant
             ): boolean;//实际使用的函数，内部调用了datasettoexcelsheet，在外面加入ui接口和错误处理
function datasettoexcel
            (
             dataset     :tdataset;   // 要转换的数据集
             fieldtagmax :integer;  // 字段的tag值如果大于这个值，就不导出到excel
             visible     :boolean;      // 是否让做转换工作的excel可见
             excelfilename:string='' // excel文件名，*.xls
             ): boolean;implementationfunction datasettoexcelsheet(dataset:tdataset;fieldtagmax:integer;sheet:olevariant): boolean;
var
   row,col,fieldindex :integer;
   bk:tbook;
begin
   result := false;
   if not dataset.active then exit;
   bk:=dataset.getbook;
   dataset.disablecontrols;   sheet.activate;
   try     // 列标题
     row:=1;
     col:=1;
     for fieldindex:=0 to dataset.fieldcount-1 do
         begin
         if dataset.fields[fieldindex].tag <= fieldtagmax then
            begin
            sheet.cells(row,col)  :=dataset.fields[fieldindex].displaylabel;
            inc(col);
            end;
         end;
     // 表内容
     dataset.first;
     while not dataset.eof do
        begin
        row:=row+1;
        col:=1;
        for fieldindex:=0 to dataset.fieldcount-1 do
            begin
            if dataset.fields[fieldindex].tag <= fieldtagmax then
               begin
               sheet.cells(row,col):=dataset.fields[fieldindex].asstring;
               inc(col);
               end;
            end;
        dataset.next;
        end;     result := true;
     finally
       dataset.gotobook(bk);
       dataset.enablecontrols;
    end;  
end;
function datasettoexcel(
                  dataset:tdataset;fieldtagmax:integer;
                  visible:boolean;excelfilename:string=''): boolean;
var
   excelobj, excel, workbook, sheet: olevariant;
    oldcursor:tcursor;
   savedialog:tsavedialog;
begin
   result := false;
   if not dataset.active then exit;   oldcursor:=screen.cursor;
   screen.cursor:=crhourglass;   try
      excelobj := createoleobject('excel.sheet');
      excel := excelobj.application;
      excel.visible := visible ;
      workbook := excel.workbooks.add ;
      sheet:= workbook.sheets[1];
   except
      messagebox(getactivewindow,'无法调用mircorsoft excel! '+chr(13)+chr(10)+
                    '请检查是否安装了mircorsoft excel。','提示',mb_ok+mb_iconinformation);
      screen.cursor:=oldcursor;
      exit;
   end;   result:=datasettoexcelsheet(dataset,fieldtagmax,sheet) ;
   if result then
      if not visible then
         begin
         if excelfilename<>''
            then workbook.saveas(filename:=excelfilename)
            else begin
                 savedialog:=tsavedialog.create(nil);
                 savedialog.filter := 'microsoft excel 文件|*.xls';
                 result:=savedialog.execute;
                 updatewindow(getactivewindow);
                 if result then
                    workbook.saveas(filename:=savedialog.filename);
                 savedialog.free;
                 end;
         excel.quit;
         end;
   screen.cursor:=oldcursor;
end;
end.

Answer 2

procedure TForm1.SaveToExcel(Db_data:TDBGrid);
var
    XlAPP:Variant;
    excelcount:integer;
    Sheet1:Variant;
    i,j:integer;
begin
    if not Db_data.DataSource.DataSet.Active then exit;
    if Db_data.DataSource.DataSet.RecordCount<1 then exit;
    //创建excel对象
    try
        XlApp:=createoleobject('Excel.Application');
        XLApp.Visible:=false;
        excelcount:=XLApp.Workbooks.count;
        XLApp.Workbooks.Add(xlWBatWorkSheet);
        Sheet1 := XLApp.Workbooks[1].WorkSheets['sheet1'];
    except
        showmessage('你的电脑没出息有安装excel程序，无法完成此功能!');
        exit;
    end;
    //setfocus;处理标题
    for j:=0 to Db_data.FieldCount-1 do
    begin
        sheet1.cells[1,j+1]:=Db_data.Columns[j].Title.Caption;
    end;
    //处理记录
    Db_data.DataSource.DataSet.First;
    i:=2;
    while not Db_data.DataSource.DataSet.Eof do
    begin
       //处理一行
       for j:=0 to Db_data.FieldCount-1 do
       begin
            if Db_data.Fields[j]<>nil then
                Sheet1.cells[i,j+1]:=trim(Db_data.Fields[j].asstring)
            else
                Sheet1.cells[i,j+1]:='';
       end;
       i:=i+1;
       Db_data.DataSource.DataSet.Next;
    end;
    XLApp.Visible:=true;
end;

Answer 3

上面的两个程序虽然都可以
可是客户必须安装Excel
我这里有一个程序，是通过流来生成Excel格式报表的，就算是机器没有装Excel也可以把
DbGrid中的数据导出到Excel中
不过程序有点长不好贴出来
需要的话给我发邮件
[email protected]

Answer 4

My e_mail address is [email protected] you very much.

Answer 5

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables,excel97,comobj, Grids, DBGrids;
type
Tmainform = class(TForm)
Table1: TTable;
Button1: TButton;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure ExportDBGrid(toExcel: Boolean);
public
{ Public declarations }
end;
var
mainform: Tmainform;
implementation
{$R *.dfm}
procedure Tmainform.Button1Click(Sender: TObject);
begin
ExportDBGrid(true);
end;
//toexcel=true时输出到excel工作表,否则仅贴到剪贴板
procedure Tmainform.ExportDBGrid(toExcel: Boolean);
var
bm: TBook; //数据集书签
col, row: Integer;//dbgrid中的行,列
sline: String;
mem: TMemo; //临时memo控件
ExcelApp: Variant;
begin
DBGrid1.DataSource.DataSet.DisableControls;
bm := DBGrid1.DataSource.DataSet.GetBook;//记录当前位置
DBGrid1.DataSource.DataSet.First;// 创建Excel对象
if toExcel then 
begin
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Grid Data';
end; 
//创建监时Tmemo控件
mem := TMemo.Create(Self);
mem.Visible := false;
mem.Parent := MainForm;
mem.Clear;
//sline := '';
// 首先加表头到mem
for col := 0 to DBGrid1.FieldCount-1 do
sline := sline + DBGrid1.Fields[col].DisplayLabel + #9;
mem.Lines.Add(sline);// 遍历dbgrid1加数据到 mem
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; //贴到剪贴板
mem.SelectAll;
mem.CopyToClipboard;// paste以前面已建好的excel的worksheets中
if toExcel then
begin
ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste;
ExcelApp.save;//弹出保存对话框
//ExcelApp.Visible := true; //是否显示excel表格
end;
FreeAndNil(mem);//释放监时Tmemo(mem)
// FreeAndNil(ExcelApp);
DBGrid1.DataSource.DataSet.GotoBook(bm); //回到原来位置
DBGrid1.DataSource.DataSet.FreeBook(bm); //释放书签
DBGrid1.DataSource.DataSet.EnableControls; 
end;
end.

Answer 6

也给我发一个把
我的信箱[email protected]