将几个DBGRID里的内容导入一个EXCEL表中

时间:2010-01-30 08:19:54  来源:第二电脑网  作者:第二电脑网

  第二电脑网导读:rdercolor="#00c000" cellspacing="0" bordercolordark="#ffffff" cellpadding="5" width="99%" bgcolor="#e8ffe8" border="1">Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids, ActiveX, ComObj,Excel2000, OleServer;
  正文:前言:

  在软件实际制作中,为节省开发成本和开发周期,一些软件人员通常会吧DBGrid中的数据直接导出到Excel表中,而先前能看到的函数仅仅只能在WorkBook的一个Sheet中导入数据,不支持多Sheet!。

单元应用:


Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids, ActiveX, ComObj,
Excel2000, OleServer;

测试环境:

  OS:Win2k Pro;Excel2k;Delphi6.0

源程序:  

"将几个DBGRID里的内容导入一个EXCEL表中"由第二电脑网原创提供,转载请注明:http://www.002pc.com/master/College/Language/Delphi/12624.html


关键字:

关于《将几个DBGRID里的内容导入一个EXCEL表中》文章的评论


{
功能描述:把DBGrid输出到Excel表格(支持多Sheet)
设计:CoolSlob
日期:2002-10-23
支持:CoolSlob@163.com
调用格式: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;
    end;
    
    XlApp.Visible := True;
    Screen.Cursor := crDefault;
  end;
站内搜索: 高级搜索

热门搜索: Windows style 系统 tr IP QQ CPU 安装 function 注册 if td