求DBGridEh导出到Excel最快的方法

Question

求DBGridEh导出到Excel最快的方法，那位兄弟有，发出来他享一下啊！谢谢了，给80分

Answer 1

还是直接告诉你的好，你去下载DBGridToExcel组件，不但支持DBGridEh，普通DBGrid也可以导出到Excel。请帮我加80分。^_^

Answer 2

{   背景：今天要把DataSet导入Excel，查询以前的贴子，一部分用Ole，速度太慢，
         一部分用ADO连接到Excel文件，也很慢，一气之下把DBGrigEh的导出部分改了出来，
         欢迎大家指教、改进。
   功能：将数据集的数据导入Excel;
   用法：With TDS2Excel.Create(TDataSet(ADOQuery1)) do
         Try
           Save2File(SaveDialog1.FileName, True);
         finally
           Free;
         end;
   作者：Caidao (核心代码来自Ehlib)
   时间：2003-04-09
   地点：汕头
}    
unit UntObject;interfaceUses
 DB, Classes;var
 CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
 CXlsEof: array[0..1] of Word = ($0A, 00);
 CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
 CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
 CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
 CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);Type
 TDS2Excel = Class(TObject)
 Private
   FCol: word;
   FRow: word;
   FDataSet: TDataSet;
   Stream: TStream;
   FWillWriteHead: boolean;
   FBookMark: TBook;
   procedure IncColRow;
   procedure WriteBlankCell;
   procedure WriteFloatCell(const AValue: Double);
   procedure WriteIntegerCell(const AValue: Integer);
   procedure WriteStringCell(const AValue: string);
   procedure WritePrefix;
   procedure WriteSuffix;
   procedure WriteTitle;
   procedure WriteDataCell;   procedure Save2Stream(aStream: TStream);
 Public
   procedure Save2File(FileName: string; WillWriteHead: Boolean);
   Constructor Create(aDataSet: TDataSet);
 end;implementationuses SysUtils;Constructor TDS2Excel.Create(aDataSet: TDataSet);
begin
 inherited Create;
 FDataSet := aDataSet;
end;procedure TDS2Excel.IncColRow;
begin
 if FCol = FDataSet.FieldCount - 1 then
 begin
   Inc(FRow);
   FCol :=0;
 end
 else
   Inc(FCol);
end;procedure TDS2Excel.WriteBlankCell;
begin
 CXlsBlank[2] := FRow;
 CXlsBlank[3] := FCol;
 Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
 IncColRow;
end;procedure TDS2Excel.WriteFloatCell(const AValue: Double);
begin
 CXlsNumber[2] := FRow;
 CXlsNumber[3] := FCol;
 Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
 Stream.WriteBuffer(AValue, 8);
 IncColRow;
end;procedure TDS2Excel.WriteIntegerCell(const AValue: Integer);
var
 V: Integer;
begin
 CXlsRk[2] := FRow;
 CXlsRk[3] := FCol;
 Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
 V := (AValue shl 2) or 2;
 Stream.WriteBuffer(V, 4);
 IncColRow;
end;procedure TDS2Excel.WriteStringCell(const AValue: string);
var
 L: Word;
begin
 L := Length(AValue);
 CXlsLabel[1] := 8 + L;
 CXlsLabel[2] := FRow;
 CXlsLabel[3] := FCol;
 CXlsLabel[5] := L;
 Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
 Stream.WriteBuffer(Pointer(AValue)^, L);
 IncColRow;
end;procedure TDS2Excel.WritePrefix;
begin
 Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;procedure TDS2Excel.WriteSuffix;
begin
 Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;procedure TDS2Excel.WriteTitle;
var
 n: word;
begin
 for n := 0 to FDataSet.FieldCount - 1 do
   WriteStringCell(FDataSet.Fields[n].FieldName);
end;procedure TDS2Excel.WriteDataCell;
var
 n: word;
begin
 WritePrefix;
 if FWillWriteHead then WriteTitle;
 FDataSet.DisableControls;
 FBookMark := FDataSet.GetBook;
 FDataSet.First;
 while not FDataSet.Eof do
 begin
   for n := 0 to FDataSet.FieldCount - 1 do
   begin
     if FDataSet.Fields[n].IsNull then
       WriteBlankCell
     else begin
       case FDataSet.Fields[n].DataType of
         ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
             WriteIntegerCell(FDataSet.Fields[n].AsInteger);
         ftFloat, ftCurrency, ftBCD:
             WriteFloatCell(FDataSet.Fields[n].AsFloat);
       else
         WriteStringCell(FDataSet.Fields[n].AsString);
       end;
     end;
   end;
   FDataSet.Next;
 end;
 WriteSuffix;
 if FDataSet.BookValid(FBookMark) then FDataSet.GotoBook(FBookMark);
 FDataSet.EnableControls;
end;procedure TDS2Excel.Save2Stream(aStream: TStream);
begin
 FCol := 0;
 FRow := 0;
 Stream := aStream;
 WriteDataCell;
end;procedure TDS2Excel.Save2File(FileName: string; WillWriteHead: Boolean);
var
 aFileStream: TFileStream;
begin
 FWillWriteHead := WillWriteHead;
 if FileExists(FileName) then DeleteFile(FileName);
 aFileStream := TFileStream.Create(FileName, fmCreate);
 Try
   Save2Stream(aFileStream);
 Finally
   aFileStream.Free;
 end;
end;end. 2003-5-17 22:28:00    
查看评语???     2003-6-21 21:03:31    增加一个过程，用起来要方便一些 
procedure TDS2Excel.Save2File(WillWriteHead: Boolean);
var
 SaveDialog1: TSaveDialog;
begin
 SaveDialog1 := TSaveDialog.Create(nil);
 Try
   SaveDialog1.Filter := 'Excel文档|*.xls';
   SaveDialog1.InitialDir := 'D:\';
   if not SaveDialog1.Execute then exit;
   Save2File(SaveDialog1.FileName, WillWriteHead);
 Finally
   SaveDialog1.Free;
 end;
end; 

Answer 3

ADelphiCoder 的方法写的很详细,我试一下看行不行.呵

Answer 4

不知樓主有沒有用過mssql的bcp 命令,它可以導出多種格式(*.xls,*.doc,*.csv,*.html...)
可以在delphi中調用bcp 來導出

Answer 5

uses DBGridEHImpExp;SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,……就是这么简单

Answer 6

谁帮我解决dbgrid导出来excel问题，将会得到价值30元的Q币或30元的手机话费

  

Answer 7

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Excel2000, OleServer, OleCtnrs, DB, Grids, DBGrids,
  ADODB;type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    OleContainer1: TOleContainer;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelApplication1: TExcelApplication;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
if fileexists('11.xls') then
deletefile('11.xls');try
excelapplication1.Connect ;
except
application.MessageBox('您的系統還未安裝EXCEL','提示',mb_okcancel);
exit;
end;//創建一個工作舖
excelapplication1.Workbooks.Add(null,0);
excelworkbook1.ConnectTo(excelapplication1.Workbooks[1]);//創建sheet
try
excelworkbook1.Worksheets.Add(null,
excelworkbook1.Worksheets[excelworkbook1.Worksheets.count],null,null,0);
except
application.MessageBox('創建失敗','提示',mb_okcancel);
exit;
end;excelworksheet1.ConnectTo(excelworkbook1.Worksheets[1]as _worksheet );//把字段的標題列出來for i:=0 to adoquery1.FieldCount-1 do
begin
excelworksheet1.Cells.Item[1,i+1].value:=adoquery1.Fields[i].DisplayLabel ;
end;//把值列出來adoquery1.First ;
while not adoquery1.Eof do
begin
for i:=0 to adoquery1.FieldCount-1 do
begin
excelworksheet1.Cells.Item[adoquery1.RecNo+1,i+1].value:=adoquery1.Fields[i].AsString ;
end;
adoquery1.Next ;
end;//保存
try
excelworksheet1.SaveAs(extractfilepath(paramstr(0))+'11.xls');
except
application.MessageBox('保存失敗','提示',mb_okcancel);
end;//斷開聯接
excelworksheet1.Disconnect ;
excelworkbook1.Disconnect ;
excelapplication1.Disconnect ;
excelapplication1.Quit ;//打開工作表
olecontainer1.CreateLinkToFile(extractfilepath(paramstr(0))+'11.xls',false);
olecontainer1.DoVerb(0);end;end.

Answer 8

上面幾個DBGrid1,DataSource1,OleContainer1,ExcelWorkbook1,ExcelWorksheet1,ExcelApplication1
都是delphi7自帶的的控件。上面的代碼可以說是十分的簡單。可對我來說，無認是3樓和我剛寫的代嗎都是好多。
我用mssql的Bcp 命今來做，代碼不超過10行就可以搞定，可是有一個小的遺憾就是就bcp 導出的excel文件沒有列
標題。

Answer 9

fa_ge帅哥的帖子真的可以解决问题，谢谢了！

Answer 10

我来把这个帖子顶上去。din.....

Answer 11

DBGridEh他自身就支持导出Excel,txt,htm等格式了// 导出 DBGridEh 数据
procedure DBGridEh_Export(DBGridEh: TDBGridEh; Form: TForm);
var
  ExpClass:TDBGridEhExportClass;
  Ext, sSave:String;
  SaveDialog: TSaveDialog;
begin
  SaveDialog:= TSaveDialog.Create(Nil);
  SaveDialog.FileName:= Form.Caption;
  SaveDialog.Filter:='Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Rich Text Format (*.rtf)|*.RTF|Microsoft Excel Workbook (*.xls)|*.XLS';
  sSave := Trim(ExtractFilePath(Application.ExeName)) + '导出数据';  if not DirectoryExists(sSave) then
  begin
    if not CreateDir(sSave) then
    begin
      raise Exception.Create('不能新建目录,请手工新建这目录。' + #13 + sSave);
    end;
  end;
  SaveDialog.InitialDir:= sSave;  if SaveDialog.Execute then
  begin
    case SaveDialog.FilterIndex of
      1:  begin ExpClass  :=  TDBGridEhExportAsText;  Ext :=  'txt';  end;
      2:  begin ExpClass  :=  TDBGridEhExportAsCSV;   Ext :=  'csv';  end;
      3:  begin ExpClass  :=  TDBGridEhExportAsHTML;  Ext :=  'htm';  end;
      4:  begin ExpClass  :=  TDBGridEhExportAsRTF;   Ext :=  'rtf';  end;
      5:  begin ExpClass  :=  TDBGridEhExportAsXLS;   Ext :=  'xls';  end;
    else
      ExpClass := nil; Ext := '';
    end;
    if ExpClass <> nil then
    begin
      if UpperCase(Copy(SaveDialog.FileName,Length(SaveDialog.FileName)-2,3)) <> UpperCase(Ext) then
         SaveDialog.FileName := SaveDialog.FileName + '.' + Ext;
      SaveDBGridEhToExportFile(ExpClass,DBGridEh,SaveDialog.FileName,not DBGridEh.CheckCopyAction);
      Application.MessageBox('数据成功导出！','信息',64);       
    end;
  end;
end;

Answer 12

写一个函数:
procedure TForm1.ExportReport(grid: TDBGridEh; saveFileName: String);
var
  ExpClass: TDBGridEhExportClass;
  Ext: string;
 // typeID:Integer;
 // thisFileName:String;
 // fromDayStr,toDayStr:String;
begin
  ExpClass := TDBGridEhExportAsXLS;
  SaveDialog1.Filter:='Microsoft Excel 工作簿 (*.xls)|*.xls'; Ext:='xls';
  if saveFileName<>'' then SaveDialog1.FileName:=saveFileName;
  if SaveDialog1.Execute then begin
    if SaveDialog1.FileName = '' then begin
      ExpClass := nil;
      Ext := '';
    end;
  end;
  if ExpClass <> nil then
  begin
    if UpperCase(Copy(SaveDialog1.FileName,
                      Length(SaveDialog1.FileName) - 2,
                      3)) <>UpperCase(Ext) then begin
      SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext;
    end;
    SaveDBGridEhToExportFile(ExpClass, grid, SaveDialog1.FileName, true);
  end;end;
然后调用:
procedure TMeterdata.SpeedButton2Click(Sender: TObject);
begin
  ExportReport(DBGridEh1);
end;你试试,不行再讨论

Answer 13

DBGridEh自带导出Excel格式文件，
引用DBGridEhImpExp　单元
SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1,SaveDialog1.FileName,True);
楼上一位朋友建议用DBGridToExcel
不知道这个控件能不能导出DBGridEh控件里的合计行