如何将几个DBGRID里的内容发现同一个EXCEL表中？

Question

用ADOQUERY做查询SQL数据库操作，对应如下：
adoquery1 -> dbgrid1
adoquery2 -> dbgrid2
adoquery3 -> dbgrid3
现在想把三个DBGRID里的内容放到同一个EXCEL表中，分别放到同一个EXCEL表的不同SHEET里。
adoquery1 -> dbgrid1 -> excel sheet1
adoquery2 -> dbgrid2 -> excel sheet2
adoquery3 -> dbgrid3 -> excel sheet3
请问要怎么实现？具体的代码是什么？

Answer 1

你没有导出到Excel的代码吗？
你发的两条消息内容不一样？！

Answer 2

/////////我帮你贴出来，也好让有识之士共同探讨：）您好，我现在碰到一个难题，在上面提了好久的问题都没能解决，只有求救您了，我有个数据库，是paradox的，数据库里有四张表，以前我备份是用BatchMove,可以备份，可是那就需要客户去选择每张表，老总说容易被客户选混，让我一次性在客户点击“备份”按钮后直接将整个数据库备份到客户指定的目录下，恢复则反之，急，请帮帮忙！谢谢！

Answer 3

我有导出的代码。
但问题是怎么把几个DBGRID里的内容导入到一个EXCEL表里的不同SHEET中。
如：
adoquery1 -> dbgrid1 -> excel sheet1
adoquery2 -> dbgrid2 -> excel sheet2
adoquery3 -> dbgrid3 -> excel sheet3

Answer 4

给你一段代吗，但是单个DBGrid的导出，相信你做一些修改就能用了。
请在USES中加ComObj,Excel2000！procedure CopyDbDataToExcel(Target: TDbgrid);
var
    iCount, jCount: Integer;
    XLApp: Variant;
    Sheet: Variant;
begin
    Screen.Cursor := crHourGlass;
    if not VarIsEmpty(XLApp) then
    begin
        XLApp.DisplayAlerts := False;
        XLApp.Quit;
        VarClear(XLApp);
    end;
    //通过ole创建Excel对象
    try
    XLApp := CreateOleObject('Excel.Application');
    except
    Screen.Cursor := crDefault;
    Exit;
    end;
    XLApp.WorkBooks.Add[XLWBatWorksheet];
    XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄';
    Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄'];
    if not Target.DataSource.DataSet.Active then
    begin
        Screen.Cursor := crDefault;
        Exit;
    end;
    Target.DataSource.DataSet.first;
    for iCount := 0 to Target.Columns.Count - 1 do
    begin
        Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
    end;
    jCount := 1;
    while not Target.DataSource.DataSet.Eof do
    begin
        for iCount := 0 to Target.Columns.Count - 1 do
        begin
            Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
        end;
    Inc(jCount);
    Target.DataSource.DataSet.Next;
    end;
    XlApp.Visible := True;
    Screen.Cursor := crDefault;
end;

Answer 5

XLApp.WorkBooks.Add[XLWBatWorksheet];
    XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄';
    Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄'];你控制好这几条语句就是了！！

Answer 6

http://expert.csdn.net/Expert/topic/1105/1105886.xml?temp=.5982935

Answer 7

我先试试。不成再问题。谢谢xiaoyan21(明月心)，CoolSlob()，daniel007(添) 不知谁有成型的代码没有？

Answer 8

成形的代码我没有，其实原理跟一个DBGrid是一样的，只要用不同的变量操作不同的Sheet就可以了，不过可能会慢一点
AExcelApp.SheetsInNewWorkbook := 3;
AEWorkSheet1 := AExcelApp.WorkSheets[1];
AEWorkSheet2 := AExcelApp.WorkSheets[2];
AEWorkSheet3 := AExcelApp.WorkSheets[3];

Answer 9

这是我的转成EXCEL的代码，我要怎么做改动才成实现上边我所说的功能？
----------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var c,r,i,j : integer ;
    app : Olevariant ;
    TempFileName,ResultFileName : String ;
begin
  if SaveDialog1.Execute then
     begin
         if  adoquery1.IsEmpty then
             begin
                Application.MessageBox('记录中没有数据','信息',MB_ICONINFORMATION+MB_OK);
                Abort;
             end;          try
             app := CreateOLEObject('Excel.application');
          except
             Application.MessageBox('系统错误!','警告信息',mb_OK or mb_ICONSTOP);
             exit;
          end;          TempFileName := Extractfilename(savedialog1.FileName);
          app.Workbooks.add;
          app.Visible := false;          DBGrid1.DataSource.DataSet.First;
          c:=DBGrid1.DataSource.DataSet.FieldCount;
          r:=DBGrid1.DataSource.DataSet.RecordCount;          for i:=0 to c-1 do
            app.cells(1,1+i):= DBGrid1.DataSource.DataSet.Fields[i].DisplayLabel;
          for j:=1 to r do
          begin
            for i:=0 to c-1 do
              app.cells(j+1,1+i):= DBGrid1.DataSource.DataSet.Fields[i].AsString;            DBGrid1.DataSource.DataSet.Next;
          end ;          ResultFileName := TempFileName;
          if ResultFileName='' then ResultFileName:='自动报表';
          //if FileExists(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') then
          //DeleteFile(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls');
          //extractfilepath(savedialog1.FileName)
           if FileExists(savedialog1.FileName) then
           DeleteFile(savedialog1.FileName);          //app.Activeworkbook.saveas(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') ;
          app.Activeworkbook.saveas(savedialog1.FileName);
          app.Activeworkbook.close(false);
          app.quit;
          app:=unassigned;
     end;
end;

Answer 10

哎，UP都UP累了。怎么就没有能解决一下呢？

Answer 11

你在使用的时候要记住击活你选择的SHEETS.

Answer 12

zswang(伴水)，你去那个!？帮我看看这个问题啊!!!

Answer 13

ttttttttttttttttttttttttttttttttttttttttt

Answer 14

不好意思~~~~~~到现在才给你贴出代码，你应该知道，谁都不是全职来这里“坐诊”的!!刚才花了半个小时，把代码重写了一下，我测试通过：{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
设计：CoolSlob
日期：2002-10-23
支持：[email protected]
调用格式：CopyDbDataToExcel([DBGrid1, DBGrid2]);
}
procedure CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  if not VarIsEmpty(XLApp) then
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;  try
    XLApp := CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook := High(Args) + 1;  for I := Low(Args) to High(Args) do
  begin
    XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
    Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
    
    if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;    TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      Sheet.Cells[1, iCount + 1] :=
          TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
          
    jCount := 1;
    while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
        Sheet.Cells[jCount + 1, iCount + 1] :=
            TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
            
      Inc(jCount);
      TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
    end;
    XlApp.Visible := True;
  end;
  Screen.Cursor := crDefault;
end;

Answer 15

谢谢CoolSlob()!
但为什么我调用不成功？

Answer 16

试过了，CoolSlob()兄的代码是可以的。

Answer 17

http://www.csdn.net/develop/read_article.asp?id=15417这里有更详细的测试环境说明！！

Answer 18

unit1 all code
-----------------------------
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, DBGrids, DBCtrls, DB, DBTables, ActiveX, ComObj,
  Excel2000, OleServer;
type
  TForm1 = class(TForm)
    Table1: TTable;
    Table2: TTable;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    DBNavigator1: TDBNavigator;
    DBGrid1: TDBGrid;
    DBNavigator2: TDBNavigator;
    DBGrid2: TDBGrid;
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
procedure CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  if not VarIsEmpty(XLApp) then
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;  try
    XLApp := CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook := High(Args) + 1;  for I := Low(Args) to High(Args) do
  begin
    XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
    Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];    if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;    TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      Sheet.Cells[1, iCount + 1] :=
          TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;    jCount := 1;
    while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
        Sheet.Cells[jCount + 1, iCount + 1] :=
            TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
            
      Inc(jCount);
      TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
    end;
    XlApp.Visible := True;
  end;
  Screen.Cursor := crDefault;
end;beginend;end.

Answer 19

procedure TForm1.Button1Click(Sender: TObject);这个地方则么回事？我刚刚也试了，是好试的。

Answer 20

to pukerno3(飞天)
把你的单元代码给我全贴出来，我看一下。

Answer 21

可以了，但如何控制SHEET的名称？
如何在存时让用户输入存的EXCEL表名称？(用savedialog)

Answer 22

为什么只能出现两个SHEET？我有多个DBGRID!
CopyDbDataToExcel([DBGrid1, DBGrid2, DBGrid3, DBGrid4, DBGrid5, DBGrid6, DBGrid7]);

Answer 23

谢谢楼上的各位朋友，特别感谢 CoolSlob() ， xiaoyan21(明月心) ， Snakeguo(楠) (莫等闲&up2myself) ， pukerno3(飞天) 及关注此问题的各位。
问题以解决，使用CoolSlob() 可解决此问题。
问题结贴!