dbgrid怎么导出execl表

Question

unit QueryDerive;interfaceuses
  Windows, Messages, SysUtils, Classes, forms, ComObj, dbgrids, Quickrpt, QRCtrls,
  qrprntr, printers, DB, Graphics;procedure DeriveToExcel(Title: String; DBGrid: TDBGrid; Total: Boolean);
procedure DeriveToPrint(Title: String; DBGrid: TDBGrid; Total: Boolean);implementationprocedure DeriveToExcel(Title: String; DBGrid: TDBGrid; Total: Boolean);
var
  ExcelApp, WorkBook: Variant;
  i, j: Integer;
  Row, Col: Integer;
  FieldName: string;
  DataSet: TDataSet;
  S: String;
begin  // 数据发送到 Excel
  try
    ExcelApp := CreateOleObject('Excel.Application');
    WorkBook := CreateOleObject('Excel.Sheet');
  except
    Application.MessageBox('你的机器里未安装Microsoft Excel.     ', '', 32);
    Exit;
  end;  Application.ProcessMessages;
  WorkBook := ExcelApp.WorkBooks.Add;
  Col := 1;
  ExcelApp.Cells(2, Col) := Title;
  Row := 4;
  DataSet := DBGrid.DataSource.DataSet;
  for I := 0 to DBGrid.Columns.Count - 1 do
  begin
    if DBGrid.Columns[I].Visible then
    begin
      FieldName := DBGrid.Columns[I].Title.Caption;
      ExcelApp.Cells(Row, Col) := FieldName;
      Col := Col + 1;
    end;
  end;  Row := Row + 1;  DataSet.First;
  while not DataSet.Eof do
  begin
    Col := 1;
    for J := 0 to DBGrid.Columns.Count - 1 do
    begin
      FieldName := DBGrid.Columns[J].FieldName;
      ExcelApp.Cells(Row, Col) := ' ' + DataSet.FieldByName(FieldName).AsString + ' ';
      Col := Col + 1;
    end;
    Row := Row + 1;
    DataSet.Next;
  end;  if Total then
  begin
    Col := 1;
    for J := 0 to DBGrid.Columns.Count - 1 do
    begin
      S := Char(64 + ((J+1) mod 26));
      if (J+1) > 26 then
      begin
        S := Char(65+(((J+1)-26) div 26)) + S;
      end;
      if J = 0 then
      begin
        ExcelApp.Cells(Row, Col) := '合计';
      end
      else if DBGrid.Columns[J].Field.DataType in [ftInteger, ftSmallint, ftFloat, ftBCD] then
      begin
        FieldName := DBGrid.Columns[J].FieldName;
        ExcelApp.Cells(Row, Col) := '=SUM('+S+'4:'+S+IntToStr(Row-1)+')';
      end;
      Col := Col + 1;
    end;
  end;
  ExcelApp.Visible := True;
//    WorkBook.SaveAs(SaveDialog1.FileName);
//    WorkBook.Close;
//    ExcelApp.Quit;
//    ExcelApp := Unassigned;
end;end.
我这个单元是导出execl的程序。那错了。请高手指点。并且。谁有现成的程序供我参考将有高分给予。这个程序怎么调用啊。

Answer 1

//------------------------------------------------------------------------------
//本程序的主要功能是将数据表DBGRID中的数据导出到EXCEL中
//本程序的的上一版本是comm_excel.pas
//本程序在上一版本的基础上作了更通用的扩展
//本程序支持将CARDID，等查询后作处理的数据，将表格中的数据导入到excel，
//避免了以前查询数据和显示数据不一致的问题。
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//---------------------V1.0-----------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
unit gridtoexcel;
interfaceuses OleServer, Excel97,DBGrids,dbtables,Dialogs,Sysutils,db,windows,graphics,FileCtrl,classes;var
   XLApp:TExcelApplication;
procedure CreateExcel(DBGrid:TDBGrid;Title:String);
procedure HandleData(Worksheet:_Worksheet;DBGrid:TDBGrid;Title:String);
function  textformat(str:string;count:integer):string;
implementation
//nizhigang's gbgridtoexcel .
function textformat(str:string;count:integer):string;
var
 mystr:string;
begin
 mystr:=copy('                                                 ',1,count-length(str));
 mystr:=mystr+str;
 result:=mystr;
end;procedure CreateExcel(DBGrid:TDBGrid;Title:String);
var
 WorkBks:WorkBooks;
 Workbk:_Workbook;
 WorkSheets:Sheets;
 Worksheet:_WorkSheet;
begin
   try
    XLApp:=TExcelApplication.Create(nil);
   except
     ShowMessage('打开EXCEL失败，请检查系统！');
     exit;
   end;
   XLApp.Visible[0]:=True;
   WorkBks:=XLApp.Workbooks as WorkBooks;
   WorkBks.Add(XLWBatWorkSheet,0);
   Workbk:=WorkBks.Item[1];
   WorkSheets:=Workbk.Worksheets;
   Worksheet:=Worksheets.Get_Item(1) as _WorkSheet;
   WorkSheet.Name:=Title;
   HandleData(Worksheet,DBGrid,Title);
   xlapp.Free;
end;Procedure HandleData(Worksheet:_Worksheet;DBGrid:TDBGrid;Title:String);
var
  i,j:integer;
  ARange:Range;
  max:integer;
begin
  WorKSheet.Cells.Item[1,6]:=Title;
  for i:=1 to DBGrid.Columns.Count do
    WorkSheet.Cells.Item[3,i+1]:=DBGrid.Columns.Items[i-1].Title.caption;
  dbgrid.DataSource.DataSet.First;
  i:=0;
  while not dbgrid.DataSource.DataSet.Eof  do
  begin
    for j:=0 to DBGrid.Columns.Count-1 do
      case dbgrid.Fields[j].DataType of
        ftstring:
          WorkSheet.Cells.Item[4+i,j+2]:=''''+dbgrid.Fields[j].Text;
        ftBytes:
          WorkSheet.Cells.Item[4+i,j+2]:=''''+dbgrid.Fields[j].Text;
      else
        WorkSheet.Cells.Item[4+i,j+2]:=dbgrid.Fields[j].Text;
      end;
    dbgrid.DataSource.DataSet.Next;
    i:=i+1;
  end;
  max:=dbgrid.DataSource.DataSet.RecordCount;
  ARange:=WorkSheet.Range[WorkSheet.Cells.Item[3,2],WorkSheet.Cells.Item[3,DBGrid.Columns.Count+1]];
  ARange.Columns.Interior.ColorIndex:=24;
  ARange:=WorkSheet.Range[WorkSheet.Cells.Item[3,2],WorkSheet.Cells.Item[3+Max,DBGrid.Columns.Count+1]];
  ARange.Borders.LineStyle:=xlContinuous;
end;end.

Answer 2

不明白，谁把自己的例子发到[email protected],不胜感激。如果能够实现，并且符合我们头的意见。我马上结贴。还有另外的40分。

Answer 3

InfoPower3000的套装控件中wwDBGrid有此功能!

Answer 4

我做了个函数,简单点,但好用
Procedure DBGridToExcel(Grid:TDBGrid);
var
  xlApp:Variant;//TexcelApplication;
  XlWorkBook:Variant;//_workBook;
  xlworkSheet:Variant;//_worksheet;
  LCID,I,J:integer;
 // SaveDialog:TSaveDialog;
  FileName:String;
begin
    xlapp:=CreateOleObject('Excel.application');
    XlApp.Visible:=False;
    //xlApp.Connect;
   // LCID:=GetUserDefaultLCID();    xlWorkBook:=xlApp.Workbooks.Add(-4167);
    xlWorkSheet:=xlapp.WorkBooks[1].Worksheets['sheet1'];// as _workSheet;
    //xlWorkSheet.Activate(LCID);
    //xlWorksheet.range['a1','ad100'].NumberFormatLocal := '@';
    Grid.DataSource.DataSet.DisableControls;
    I:=1;
    For J:=0 to Grid.FieldCount-1 do
    xlWorksheet.Cells[i,j+1]:=Grid.Columns[j].Title.Caption;
    I:=2 ;
       Grid.DataSource.DataSet.First;
       while not Grid.DataSource.DataSet.eof do
       begin
        For J:=0 to Grid.FieldCount-1 do
        xlworksheet.Cells[i,j+1]:=Grid.Fields[j].Value;
       i:=I+1;
       Grid.DataSource.DataSet.Next;
       end;//while
     Grid.DataSource.DataSet.EnableControls;
     xlWorkSheet.Range[xlWorkSheet.cells[1,1],xlWorkSheet.Cells[I,Grid.FieldCount]].columns.AutoFit;
     xlapp.visible:=True;end;

Answer 5

就是相当于把数据库中的数据到处到excel中呀，你可以先用查询控件得到数据，然后下面的程序你改一下，就可以了。
 
procedure TFrmMain.WriteExcel(AdsData: TADODataSet; sName, Title: string);
var
ExcelApplication1: TExcelApplication;
ExcelWorksheet1: TExcelWorksheet;
ExcelWorkbook1: TExcelWorkbook;
i, j: integer;
filename: string;
begin
filename := concat(extractfilepath(application.exename), sName, ’.xls’);
try
ExcelApplication1 := TExcelApplication.Create(Application);
ExcelWorksheet1 := TExcelWorksheet.Create(Application);
ExcelWorkbook1 := TExcelWorkbook.Create(Application);
ExcelApplication1.Connect;
except
Application.Messagebox(’Excel 没有安装!’, ’Hello’, MB_ICONERROR + mb_Ok);
Abort;
end;
try
ExcelApplication1.Workbooks.Add(EmptyParam, 0);
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
AdsData.First;
for j := 0 to AdsData.Fields.Count - 1 do
begin
ExcelWorksheet1.Cells.item[3, j + 1] := AdsData.Fields[j].DisplayLabel;
ExcelWorksheet1.Cells.item[3, j + 1].font.size := ’10’;
end;
for i := 4 to AdsData.RecordCount + 3 do
begin
for j := 0 to AdsData.Fields.Count - 1 do
begin
ExcelWorksheet1.Cells.item[i, j + 1] :=
AdsData.Fields[j].Asstring;
ExcelWorksheet1.Cells.item[i, j + 1].font.size := ’10’;
end;
AdsData.Next;
end;
ExcelWorksheet1.Columns.AutoFit;
ExcelWorksheet1.Cells.item[1, 2] := Title;
ExcelWorksheet1.Cells.Item[1, 2].font.size := ’14’;
ExcelWorksheet1.SaveAs(filename);
Application.Messagebox(pchar(’数据成功导出’ + filename), ’Hello’,
mb_Ok);
finally
ExcelApplication1.Disconnect;
ExcelApplication1.Quit;
ExcelApplication1.Free;
ExcelWorksheet1.Free;
ExcelWorkbook1.Free;
end;
end;