DBGrid使用全书(三)

把DBGrid输出到Excel表格－－－方法一
（支持多Sheet）{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：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;
dbgrid的數據導入到excel中－－－方法二

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, Db, DBTables, Excel97, OleServer, Word97;

type
  TForm1 = class(TForm)
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorksheet1: TExcelWorksheet;
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button4: TButton;
    WordApplication1: TWordApplication;
    WordDocument1: TWordDocument;
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  i, row, column: integer;
begin
  Try
    ExcelApplication1.Connect;
  Except
    MessageDlg('Excel may not be installed',
      mtError, [mbOk], 0);
    Abort;
  End;
  ExcelApplication1.Visible[0] := True;
  ExcelApplication1.Caption := 'Excel Application';
  ExcelApplication1.Workbooks.Add(Null, 0);
  ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
  ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
  DBGrid.DataSource.DataSet.Open;
  row := 1;
  While Not (DBGrid.DataSource.DataSet.Eof) do
  begin
    column := 1;
    for i := 1 to DBGrid.DataSource.DataSet.FieldCount do
    begin
      ExcelWorksheet1.Cells.Item[row, column] := DBGrid.DataSource.DataSet.fields[i - 1].AsString;
      column := column + 1;
    end;
    DBGrid.DataSource.DataSet.Next;
    row := row + 1;
  end;
end;

 

procedure TForm1.Button4Click(Sender: TObject);
begin
  ExcelApplication1.Disconnect;
  ExcelApplication1.Quit;
end;

end.
一个将dbgrid导为excel文件的过程，需要引用单元comoby，一个ExcelApplication1控件：
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;

//调用
procedure TForm2.SpeedButton5Click(Sender: TObject);
begin
copyDbDataToExcel(dbgrid1);
end;
DBGrid导入Excel---方法四
uses DBGrids,ComObj,db;

Function PDBGridExportToExcel(Dbgrid:tdbgrid;title:string):boolean;
const
{ XlSheetType }
  xlChart = -4109;
  xlDialogSheet = -4116;
  xlExcel4IntlMacroSheet = 4;
  xlExcel4MacroSheet = 3;
  xlWorksheet = -4167;
{ XlWBATemplate }
  xlWBATChart = -4109;
  xlWBATExcel4IntlMacroSheet = 4;
  xlWBATExcel4MacroSheet = 3;
  xlWBATWorksheet = -4167;
{ HorizontalAlignment}
  xlLeft=1;
  xlCenter=-4108;
  xlRight=-4152;
const
  MinColumnWidth=8;  //转入Excel中每栏最小宽度
var
 XL:variant;
 i,j:integer;
begin
  result:=false;
  if not assigned(dbgrid.DataSource) then exit;
  if not assigned(dbgrid.DataSource.DataSet) then exit;
  if not dbgrid.DataSource.DataSet.active then exit;

TRY
  TRY
      XL:=CreateOLEObject('Excel.Application');
      XL.Visible := True;
      XL.Workbooks.Add(xlWBatWorkSheet);
      XL.ActiveWorkbook.ActiveSheet.Name:=title;

      with dbgrid do
      begin
       dbgrid.DataSource.DataSet.DisableControls;
       for i:=0 to Columns.Count-1 do
       begin
        XL.ActiveWorkbook.ActiveSheet.cells[1,i+1].value:=Columns[i].Title.Caption;

        //设定列宽
        if (not Columns[i].Visible)or(Columns[i].Field=nil) then
           XL.ActiveWorkbook.ActiveSheet.Columns[i+1].ColumnWidth:=0
        else if Columns[i].Width<MinColumnWidth then
           XL.ActiveWorkbook.ActiveSheet.Columns[i+1].ColumnWidth:=MinColumnWidth  div 5
        else
           XL.ActiveWorkbook.ActiveSheet.Columns[i+1].ColumnWidth:=Columns[i].Width div 5;

        //设定列格式
        if (Columns[i].Field<>nil) then begin
          if Columns[i].Field.DataType=ftString then
            XL.ActiveWorkbook.ActiveSheet.Columns[i+1].NumberFormatLocal:='@'
          else
            XL.ActiveWorkbook.ActiveSheet.Columns[i+1].NumberFormatLocal:='G/通用格式';
        end;
       end;//with
       XL.ActiveWorkbook.ActiveSheet.Rows[1].HorizontalAlignment:=xlCenter;

       DataSource.DataSet.First;
       j:=1;
       while not DataSource.DataSet.eof do
       begin
         j:=j+1;
         XL.ActiveWorkbook.ActiveSheet.rows[j].select;
         for i:=0 to Columns.Count-1 do
           if (Columns[i].Field<>nil) then
           XL.ActiveWorkbook.ActiveSheet.cells[j,i+1].Value:=Columns[i].Field.AsString;
         DataSource.DataSet.Next;
       end;//while
      end;//with
      result:=true;
  EXCEPT
      result:=false;
  END;//TRY
FINALLY
  dbgrid.datasource.dataset.EnableControls;
END;//TRY
end;//DBToExcel

本文地址：http://com.8s8s.com/it/it4620.htm