DBGrid使用全书(三)

核心提示： 把DBGrid输出到Excel表格－－－方法一（支持多Sheet）{功能描述：把DBGrid输出到Excel表格（支持多Sheet）调用格式：CopyDbDataToExcel([DBGrid1, DBGrid2]);}PRocedure CopyDbDataToExcel(Args: array of const)

 

把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