把DBGrid輸出到Excel表格---方法一
(支持多Sheet){
功能描述:把DBGrid輸出到Excel表格(支持多Sheet)
調(diào)用格式: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的數(shù)據(jù)導(dǎo)入到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導(dǎo)為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創(chuàng)建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; 
//調(diào)用 
procedure TForm2.SpeedButton5Click(Sender: TObject); 
begin 
copyDbDataToExcel(dbgrid1); 
end; 
DBGrid導(dǎo)入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;  //轉(zhuǎn)入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;
        //設(shè)定列寬
        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;
        //設(shè)定列格式
        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
新聞熱點(diǎn)
疑難解答