寻求一个从dbgrid生成Execl文档（新建）的例子

Question

寻求一个从dbgrid生成Execl文档（新建）的例子，只要源码，不能用第三方控件。
最好能再解释一下原理。可行立即送分。

Answer 1

有源码的控件呢？
[转载]算了，算了，好像很多人问这个问题，我贴一个控件吧。
{****************************************************
Copyright  , 1999-2009 , AirSpy Tech . Co ., Ltd
      FileName : OleExcel.Pas
      Author : Tang Lu
      Version : 1.0
      Date : 1999/08/06
      Description :
        把一个表或者Query或者StringGrid中的数据保存到一个Execl文件中
      Function List :
        创建接口
        procedure CreateExcelInstance;
        把表内容放到Excel文件中
        procedure TableToExcel( const Table: TTable );
        把Query内容放到Excel文件中
        procedure QueryToExcel( const Query: TQuery );
        把StringGrid内容放到Excel文件中
        procedure StringGridToExcel( const StringGrid: TStringGrid );
        保存为Execl文件
        procedure SaveToExcel( const FileName: String);
      Demo:
        调用实例如下：
        OLEExcel1.CreateExcelInstance;
        OLEExcel1.QuerytoExcel((CurRep.DataSet as TQuery));//tablename is你的表名
        OLEExcel1.SaveToExcel(SaveDlg1.FileName);
1. --------
History: //历史修改纪录
  <author>  <time>     <version>   <desc>
  Tanglu   1999/08/06     1.0    build this moudle
****************************************************}

Answer 2

[转载] 续1
unit OleExcel;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  comobj, DBTables, Grids;
type
  TOLEExcel = class(TComponent)
  private
    FExcelCreated: Boolean;
    FVisible: Boolean;
    FExcel: Variant;
    FWorkBook: Variant;
    FWorkSheet: Variant;
    FCellFont: TFont;
    FTitleFont: TFont;
    FFontChanged: Boolean;
    FIgnoreFont: Boolean;
    FFileName: TFileName;
    procedure SetExcelCellFont(var Cell: Variant);
    procedure SetExcelTitleFont(var Cell: Variant);
    procedure GetTableColumnName(const Table: TTable; var Cell: Variant);
    procedure GetQueryColumnName(const Query: TQuery; var Cell: Variant);
    procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
  protected
    procedure SetCellFont(NewFont: TFont);
    procedure SetTitleFont(NewFont: TFont);
    procedure SetVisible(DoShow: Boolean);
    function GetCell(ACol, ARow: Integer): string;
    procedure SetCell(ACol, ARow: Integer; const Value: string);    function GetDateCell(ACol, ARow: Integer): TDateTime;
    procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateExcelInstance;
    property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
    property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
    function IsCreated: Boolean;
    procedure TableToExcel(const Table: TTable);
    procedure QueryToExcel(const Query: TQuery);
    procedure StringGridToExcel(const StringGrid: TStringGrid);
    procedure SaveToExcel(const FileName: string);
  published
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property CellFont: TFont read FCellFont write SetCellFont;
    property Visible: Boolean read FVisible write SetVisible;
    property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
    property FileName: TFileName read FFileName write FFileName;
  end;procedure Register;implementation

Answer 3

[转载] 续2
constructor TOLEExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIgnoreFont := True;
  FCellFont := TFont.Create;
  FTitleFont := TFont.Create;
  FExcelCreated := False;
  FVisible := False;
  FFontChanged := False;
end;destructor TOLEExcel.Destroy;
begin
  FCellFont.Free;
  FTitleFont.Free;
  inherited Destroy;
end;procedure TOLEExcel.SetExcelCellFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FCellFont do
    begin
      Cell.Font.Name := Name;
      Cell.Font.Size := Size;
      Cell.Font.Color := Color;
      Cell.Font.Bold := fsBold in Style;
      Cell.Font.Italic := fsItalic in Style;
      Cell.Font.UnderLine := fsUnderline in Style;
      Cell.Font.Strikethrough := fsStrikeout in Style;
    end;
end;procedure TOLEExcel.SetExcelTitleFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FTitleFont do
    begin
      Cell.Font.Name := Name;
      Cell.Font.Size := Size;
      Cell.Font.Color := Color;
      Cell.Font.Bold := fsBold in Style;
      Cell.Font.Italic := fsItalic in Style;
      Cell.Font.UnderLine := fsUnderline in Style;
      Cell.Font.Strikethrough := fsStrikeout in Style;
    end;
end;

Answer 4

在窗体上放下列控件：TExcelApplication，TExcelWorksheet，TExcelWorkbook，然后调用下列函数
Function DataSetToExcel(DS : TDBGrid;ExcelApplication1: TExcelApplication;ExcelWorksheet1: TExcelWorksheet;
                           ExcelWorkbook1: TExcelWorkbook;FName,DisName : String) : boolean;
var
  Column : Integer;
  S : String;
  SaveFile :OleVariant;
  aSheet  :Variant;
  tsList  :TStringList;
begin
  Result := false;
    try
      ExcelApplication1.Connect;
    Except
      MessageDlg('可能没有安装EXCEL软件',mtError, [mbOk], 0);
      Abort;
    end;
    ExcelApplication1.Caption := DisName;   try
     ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(Null,0));
     ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);     asheet := ExcelWorkbook1.Worksheets.Item[1];
     tsList:=TStringList.Create;     DS.DataSource.DataSet.DisableControls;
     for Column := 0 to DS.Columns.Count-1 do
     begin
       if not DS.Columns[Column].Visible then Continue;
       S := S + DS.Columns[Column].Title.Caption +#9;
       Application.ProcessMessages;
     end;
     tsList.Add(s);     with DS.DataSource.DataSet do
     begin
       first;
       while not eof do
       begin
         S := '';
         for Column := 0 to DS.Columns.Count - 1 do
         begin
           if not DS.Columns[Column].Visible then Continue;
           S := S + fieldByName(DS.Columns[Column].FieldName).AsString + #9;
           Application.ProcessMessages;
         end;
         tsList.Add(s);
         next;
       end;
     end;
     DS.DataSource.DataSet.EnableControls;
      Clipboard.AsText := tsList.Text ;
      aSheet.Paste;
      ExcelWorksheet1.SaveAs(FName); //另存为
      Result := true;
    Finally
      tsList.Free;
      ExcelApplication1.Quit;
      ExcelWorksheet1.Disconnect;
      ExcelWorkbook1.Disconnect;
      ExcelApplication1.Disconnect;
    end;
end;

Answer 5

告诉地址，发给你
[email protected]

Answer 6

[转载] 续3procedure TOLEExcel.SetVisible(DoShow: Boolean);
begin
  if not FExcelCreated then exit;
  if DoShow then
    FExcel.Visible := True
  else
    FExcel.Visible := False;
end;function TOLEExcel.GetCell(ACol, ARow: Integer): string;
begin
  if not FExcelCreated then exit;
  result := FWorkSheet.Cells[ARow, ACol];
end;procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := Value;
end;
function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
  if not FExcelCreated then
    begin
      result := 0;
      exit;
    end;
  result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := '''' + DateTimeToStr(Value);
end;procedure TOLEExcel.CreateExcelInstance;
begin
  try
    FExcel := CreateOLEObject('Excel.Application');
    FWorkBook := FExcel.WorkBooks.Add;
    FWorkSheet := FWorkBook.WorkSheets.Add;
    FExcelCreated := True;
  except
    FExcelCreated := False;
  end;
end;function TOLEExcel.IsCreated: Boolean;
begin
  result := FExcelCreated;
end;procedure TOLEExcel.SetTitleFont(NewFont: TFont);
begin
  if NewFont <> FTitleFont then
    FTitleFont.Assign(NewFont);
end;procedure TOLEExcel.SetCellFont(NewFont: TFont);
begin
  if NewFont <> FCellFont then
    FCellFont.Assign(NewFont);
end;procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to Table.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := Table.Fields[Col].FieldName;
    end;
end;procedure TOLEExcel.TableToExcel(const Table: TTable);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if Table.Active = False then exit;  GetTableColumnName(Table, Cell);
  Row := 2;
  with Table do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;

Answer 7

[转载] 续4
procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to Query.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := Query.Fields[Col].FieldName;
    end;
end;
procedure TOLEExcel.QueryToExcel(const Query: TQuery);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if Query.Active = False then exit;  GetQueryColumnName(Query, Cell);
  Row := 2;
  with Query do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Col := 0 to StringGrid.FixedCols - 1 do
    for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Row := 0 to StringGrid.FixedRows - 1 do
    for Col := 0 to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row, x, y: LongInt;
begin
  Col := StringGrid.FixedCols;
  Row := StringGrid.FixedRows;
  for x := Row to StringGrid.RowCount - 1 do
    for y := Col to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[x + 1, y + 1];
        SetExcelCellFont(Cell);
        Cell.Value := StringGrid.Cells[y, x];
      end;
end;procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  GetFixedCols(StringGrid, Cell);
  GetFixedRows(StringGrid, Cell);
  GetStringGridBody(StringGrid, Cell);
end;procedure TOLEExcel.SaveToExcel(const FileName: string);
begin
  if not FExcelCreated then exit;
  FWorkSheet.SaveAs(FileName);
end;procedure Register;
begin
  RegisterComponents('Tanglu', [TOLEExcel]);
end;end.

Answer 8

将上面的代码,COPY下去,然后从"安装控件"的地方直接安装他的PAS文件,就行了.
其原理是:通过OLE创建一个EXCEL的对角,然后把你的GRID里的东西,一格一格的填到对应的EXCEL表上去,最后保存;

Answer 9

http://202.195.100.198:8080/bbs/showthread.php?s=&threadid=218
去看看,里面有很詳細的介紹.它是用代碼實現的

Answer 10

我的邮件地址是:[email protected] ,情fansnaf(投币一元) 发个给我吧！

Answer 11

function Tbrowse.ExportToExcel(defaultName: string;
  Grid: TDBGridEh):boolean;
var
  lcid:integer;
var
    ls_FileName:string;
    I,K,N,J,x:integer;
      y       :integer;
    tsList  :TStringList;
    s       :string;
    aSheet,M:Variant;
begin
result:=false;
LCID:=GetUserDefaultLCID();
  if not Grid.DataSource.DataSet.Active then // if 5
  begin
    Application.Messagebox('未与数据库连接！','消息',mb_OK+mb_IconStop);
    Exit;
  end; //end if 5
  Grid.DataSource.DataSet.DisableControls;
  //如果未装Excel，则退出。
  try   //try 30
    Excel.Connect;                  // 打开Excel
    Excel.Visible[LCID]:=false;
    Excel.Workbooks.Add(xlWBATWorksheet,0);
    aSheet:=excel.Worksheets.Item[1];
  except
    Application.MessageBox('无法打开Xls文件，请确认已经安装EXCEL.','警告',mb_OK+mb_IconStop);
    Exit;
  end;   //end try 30
  Dlg_SaveToFile.FileName:=defaultName;
  if not Dlg_SaveToFile.Execute Then Exit;
  ls_FileName:=Dlg_SaveToFile.FileName;
  try  //try 15
    K:=1;
    N:=Grid.Columns.count;
    I:=Grid.DataSource.DataSet.RecordCount;
    tsList:=TStringList.Create;    try
    Grid.DataSource.DataSet.first;
    FormProgress:=TFormProgress.Create (self);
    FormProgress.Show;
    while not Grid.DataSource.DataSet.Eof do
     begin                    s:='';
                    for y:=0 to n-1 do
                    begin
                        s:=s+Grid.DataSource.DataSet.Fields[y].AsString+#9;
                        Application.ProcessMessages;
                    end;
                    tsList.Add(s);
                    FormProgress.ProgressBar1.Position:=Trunc((K*100)/I);
                    INC(K);
                    FormProgress.Refresh;
                    Grid.DataSource.DataSet.next;
     end;
     finally
     Clipboard.AsText:=tsList.Text;
     formprogress.ProgressBar1.visible:=false;
     formprogress.ProgressBar2.visible:=true;
     if I<5 then
     asheet.paste
     else
     begin
     x:=I div 5;
     M:=I/x;
     formprogress.ProgressBar2.Min:=0;
     formprogress.ProgressBar2.Max:=M;
     formprogress.StaticText1.caption:='正在写入Excel文件';
     for J:=1 to M do
     begin
     aSheet.Paste;
     FormProgress.ProgressBar2.Position:=J;
     end;
     FormProgress.Hide;
     FormProgress.free;
     end;
     end;
   try
    Excel.DisplayAlerts[LCID]:= false;
    aSheet.Saveas(ls_FileName);
    result:=true;
    MessageBox(Application.Handle,'数据导出完毕！','系统提示',MB_ICONINFORMATION or MB_OK);
   except
    Application.Messagebox('数据导出错误！','消息',mb_OK+MB_ICONINFORMATION);
    Exit;
   end;   //
     finally
        tsList.Free;
        Grid.DataSource.DataSet.EnableControls;
        Excel.disconnect;
        Excel.Quit;
        aSheet:=Unassigned; //释放VARIANT变量
    end;
end;

Answer 12

这样的第三方控件太多了，下载后，打开这个包，然后直接compile和install即可安装到你的Delphi控件面板上，以后呢你就像使用普通的控件那样用它啦