求助：关于DBGRID数据导出到EXCEL

Question

请教各位大侠,如何利用SaveDialog在E盘的目录下,生成一个新EXCEL表，并将adoquery的查询结果导出到此新的EXCEL表里面?

Answer 1

在delphi6中有一个例子就是直接把dbgrid中select显示的数据，转 到EXCEL 中
d7中我不知道有没有，好久都没有了
以前做erp的时候经常用到，很好用，也很方便，你自己找一下，
如果没有我宁愿把头给你。

Answer 2

DevExpress控件包
dxdbgrid,dxcomponentprint
两句话就行
procedure TFrmMain.BtnSaveToExcelClick(Sender: TObject);
    var
    FileName:string;
begin
     if savedialog.Execute then
     begin
         filename := savedialog.FileName;
         (TdxDbGrid(printer.CurrentLink.Component)).SaveToXLS(filename,true);
     end;end;

Answer 3

unit WriteData;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGridEh, DB, ADODB, StdCtrls, Buttons, XPMenu, DBGrids;//目标是：  通过普通AdoQuery来导出数据！
//Create by yxf
//Date: 2004-10-05
//  type  TColumnsList = class(TList)
  private
    function GetColumn(Index: Integer): TColumn;
    procedure SetColumn(Index: Integer; const Value: TColumn);
  public
    property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
  end;  TColCellParams = class
  protected
    FAlignment: TAlignment;
    FBackground: TColor;
    FCol: Longint;
    FFont: TFont;
    FImageIndex: Integer;
    FReadOnly: Boolean;
    FRow: Longint;
    FState: TGridDrawState;
    FText: String;
  public
    property Alignment: TAlignment read FAlignment write FAlignment;
    property Background: TColor read FBackground write FBackground;
    property Col: Longint read FCol;
    property Font: TFont read FFont;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property ReadOnly: Boolean read FReadOnly write FReadOnly;
    property Row: Longint read FRow;
    property State: TGridDrawState read FState;
    property Text: String read FText write FText;
  end;  TWriteData = class
  private
    //FColCellParamsEh: TColCellParamsEh;
    FDBGrid: TCustomDBGrid;
    FQry: TAdoQuery;
    //FExpCols: TColumnsEhList;
    FStream: TStream;
    //function GetFooterValue(Row, Col: Integer): String;
    //procedure CalcFooterValues;
    FCol, FRow: Word;
    FSummary: TStringList;
//    FColumns: TColumnsList;
//    FCount: integer;//列总和  protected
//    FooterValues: PFooterValues;
    procedure WriteBlankCell;
    procedure WriteEnter;    
    procedure WriteIntegerCell(const AValue: Integer);
    procedure WriteFloatCell(const AValue: Double);
    procedure WriteStringCell(const AValue: String);
    procedure IncColRow;
    procedure WritePrefix;
    procedure WriteSuffix;
    procedure WriteTitle;
    procedure WriteRecord(ColumnsList: TColumnsList);
    procedure WriteDataCell(Column: TColumn; FColCellParams: TColCellParams);
    //procedure WriteFooter(ColumnsList: TColumnsEhList; FooterNo: Integer);
    //procedure WriteFooterCell(DataCol, Row: Integer; Column: TColumnEh; AFont: TFont;
  //    Background: TColor; Alignment: TAlignment; Text: String);
    property Stream: TStream read FStream write FStream;
    //property ExpCols: TColumnsEhList read FExpCols write FExpCols;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ExportToStream(AStream: TStream; IsExportAll: Boolean);
    procedure ExportToFile(FileName: String; IsExportAll: Boolean);
    property Summary: TStringList read FSummary write FSummary;
    property Qry: TAdoQuery read FQry write FQry;
    property DBGrid: TCustomDBGrid read FDBGrid write FDBGrid;
  end;
implementation{ TWriteData }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);constructor TWriteData.Create;
begin
//  FDBGrid := TCustomDBGrid.Create(self);
  FSummary := TStringList.Create ; 
  inherited;
end;destructor TWriteData.Destroy;
begin
  FSummary.Free ;
  inherited;
end;procedure TWriteData.ExportToFile(FileName: String; IsExportAll: Boolean);
var FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    ExportToStream(FileStream, IsExportAll);
  finally
    FileStream.Free;
  end;
end;procedure TWriteData.ExportToStream(AStream: TStream;
  IsExportAll: Boolean);
var
//  ColList: TColumnsEhList;
  BookMark: Pointer;
  i: Integer;
begin  FCol := 0;
  FRow := 0;  Stream := AStream;  WritePrefix;
    //写标题  WriteTitle;
  BookMark := Qry.GetBook;  Qry.DisableControls ;
  Screen.Cursor := crSQLWait;
  try
    if not Qry.Active then Qry.Open ;
    Qry.First ;
    While not Qry.Eof do
    begin
      for I := 0 to Qry.FieldCount - 1 do
      begin
        case Qry.Fields[i].DataType of
          ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
            WriteIntegerCell(Qry.Fields[i].AsInteger );
          ftFloat, ftCurrency, ftBCD{$IFDEF EH_LIB_6}, ftFMTBcd{$ENDIF}:
            WriteFloatCell(Qry.Fields[i].AsFloat);
        else
          WriteStringCell(Qry.Fields[i].AsString );
        end;
      end;
      Qry.Next ;
    end;
  finally
    Qry.GotoBook(BookMark);
    Qry.EnableControls ;
    Qry.FreeBook(BookMark);
    WriteEnter;
    WriteStringCell('查询条件:');
    WriteEnter;
    for I:= 0 to FSummary.Count - 1 do
    begin
      if FSummary.Strings[I] = '#13' then WriteEnter else
        WriteStringCell(FSummary.Strings[I]);
      WriteEnter;
    end;
    Screen.Cursor := crdefault;    
  end;
  WriteSuffix;
  ShowMessage('数据导入成功完成!');
//具体处理导出设置
end;

Answer 4

我不想使用自定义控件，不知道用delphi自带的控件能不能完成这样的功能

Answer 5

其实不用控件也不需要这么烦
var
  I: Integer;
  Str: String;
  StrList: TStringList;//用于存储数据的字符列表
begin
  StrList := TStringList.Create;
  try
    with Table1 do
    begin
      First;
      while not Eof do
      begin
        Str := '';
        for I := 0 to FieldCount-1 do
          Str := Str + Fields[I].AsString + #9;  
          StrList.Add(Str);
        Next;
      end;
      StrList.SaveToFile('test.xls');
    end;
    StrList.Free;
  except
    StrList.Free;
  end;
end;

Answer 6

{
#####################################################################
# 声明:本站资源由Delphi编程驿站[ http://www.delphidak.com ]整理收集，
#      部分资源来自于网络,转发前请注意尊重版权,如果您发现本站的资源
#      侵犯了您的版权，请来信告知，版主将立即删除。 
#                                                              
#******************** 欢迎访问Delphi编程驿站*************************
#                                                               
# Delphi编程驿站，以Delphi技术交流为宗旨的编程站点，明确的主题、一致的版面。
# 主页简介： 
# 本站的宗旨：与您共同进步、成长！
# 主栏目设置：编程技巧、源码分析、组件开发、项目合作；
# 辅栏目设置：网站简介、网站导航、站内更新、关于版主、友情链接。
# 在成长中学习，在学习中成长！我们一直在努力！！！
# ======================刀剑如梦软件创作室==============================
# ================== KingLong Software Studio ==========================  
# 站长：刀剑如梦 QQ：1917208  信箱：[email protected],[email protected]
# 网址：http://www.delphidak.com    [Delphi编程驿站]                          
# 论坛：http://www.delphibbs.com    [推荐：大富翁论坛]
# 资源：http://www.delphibox.com    [推荐：Delphi盒子]
# 资源：http://www.delphifans.com   [推荐：Delphi园地]
#*************** 如你转载，请不要删除以上信息，谢谢! **************** 
#         
######################################################################
}
unit uDBGridToExcel;interface
uses  Dialogs, Variants, Classes, Controls, Windows, SysUtils,
      Forms, Grids, DBGrids, DBTables, DB, ADODB, Math, ComObj, ActiveX;  procedure SaveToExcelFile(DBGridName: TDBGrid);implementationprocedure SaveToExcelFile(DBGridName: TDBGrid);
var
  XLApp: Variant;
  Sheet: Variant;
  WordApp, WordDoc, WordParagraph, WordRange, WordTable: Variant;
  I, J: Integer;
  SaveDialog: TSaveDialog;
  pBookMark: TBookMark;
  StrSaveFile: string;
  IntFileType: Integer;
  SltRec,SltCol: Integer;
  ColIndex, RowIndex: Integer;
begin
  if DBGridName.DataSource.DataSet.IsEmpty then begin
    MessageBox(Application.Handle, '没有任何数据,不能进行保存', '警告', MB_OK);
    Abort;
  end;
  SaveDialog := TSaveDialog.Create(nil);
  SaveDialog.Filter := 'Microsoft Excel 文件|*.xls|Microsoft Word 文件|*.doc';
  SaveDialog.Execute;
  IntFileType := SaveDialog.FilterIndex;
  StrSaveFile := SaveDialog.FileName;
  if Length(StrSaveFile) = 0 then Exit;
  try
    Screen.Cursor:=crHourGlass;
    case  IntFileType  of
    1: begin
       try
         XLApp :=CreateOleObject('Excel.Application');
         XLApp.WorkBooks.Add(-4167);
         XLApp.WorkBooks[1].WorkSheets[1].Name := '导出数据';
         Sheet := XLApp.WorkBooks[1].WorkSheets['导出数据'];
         J := 1;
       except
         MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+
                    '请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION);
         Exit;
       end;
       with DBGridName.DataSource.DataSet do
       begin
         pBookMark := GetBook;
         DisableControls;
         for I:=0 to DBGridName.Columns.Count-1 do
         begin
           if not DBGridName.Columns[I].Visible then
             Continue;
             Sheet.Cells[J,I+1] := dbgridname.Columns[I].Title.Caption;
         end;
         Inc(J);
         First;
         while not Eof do begin
           for I := 0 to DBGridName.Columns.Count-1 do begin
             if not DBGridName.Columns[I].Visible then
               Continue;
               Sheet.Cells[J,I+1] := Trim(DBGridName.DataSource.DataSet.FieldByName(DBGridName.Columns[i].FieldName).AsString);
           end;
         Inc(J);
         Next;
       end;
       GotoBook(pBookMark);
       FreeBook(pBookMark);
       EnableControls;
    end;
    XLApp.activeworkbook.saveas(StrSaveFile);
    Application.ProcessMessages;
    XLApp.Application.Quit;
  end;
  2: begin
     try
       if VarIsEmpty(WordApp) then
          WordApp := CreateOleObject('word.Application');
          WordDoc := WordApp.Documents.Add;
          WordParagraph := WordApp.ActiveDocument.Paragraphs.Add;
          WordRange := WordParagraph.Range;
          WordRange.Font.Size := 15;
          WordRange.Font.Name := '宋体';
       except
         MessageBox(GetActiveWindow,'无法调用Mircorsoft Word! '+Chr(13)+Chr(10)+
                    '请检查是否安装了Mircorsoft Word。','提示',MB_OK+MB_ICONINFORMATION);
         Abort;
       end;
       SltRec := DBGridName.SelectedRows.Count;
       SltCol := 0;
       for J := 0 to DBGridName.Columns.Count - 1 do begin
         if DBGridName.Columns[J].Visible then
           SltCol := SltCol +1;
       end;       WordRange := WordApp.ActiveDocument.Content;
       WordTable := WordApp.ActiveDocument.Tables.Add(WordRange,SltRec + 1,SltCol);
       ColIndex := 1;       for J := 0 to DBGridName.Columns.Count - 1  do begin
         if (not DBGridName.Columns[J].Visible) then
           Continue;
           WordTable.Cell(1, ColIndex).Range.InsertAfter(DBGridName.Columns[J].Title.Caption);
           ColIndex := ColIndex + 1;
       end;       RowIndex := 2;
       ColIndex := 1;
       with  DBGridName.DataSource.DataSet do begin
         First;
         pBookMark := GetBook;
         DisableControls;
         while not Eof do  begin
           for j := 0 to DBGridName.Columns.Count-1 do begin
             if (DBGridName.Columns[j].Visible<>false) then
             begin
               WordTable.Cell(RowIndex,ColIndex).Range.InsertAfter
               (DBGridName.DataSource.DataSet.Fieldbyname(DBGridName.Columns[j].FieldName).AsString);
               ColIndex := ColIndex + 1;
             end;
           end;
           RowIndex := RowIndex + 1;
           ColIndex := 1;
           Next;
         end;
         GotoBook(pBookMark);
         FreeBook(pBookMark);
         EnableControls;
       end;
       WordApp.ActiveDocument.SaveAs(StrSaveFile);
       Application.ProcessMessages;
       WordApp.Application.Quit;
       end;
     end;
  finally
    SaveDialog.Free;
    Screen.Cursor := crDefault;
  end;
end;end.

Answer 7

把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; 
 

Answer 8

支持自己编码！
或修改别人的代码；适应自己的程序要求！
我就做过4/5个不同要求的（可以从DBGrid到Excel、从ClientDataSet到Excel）
还有一点关于Excel控制的技巧。
如果你不知道某些控制如何实现，
可以通过在Excel中录制“宏”读取VB脚本；
然后改成你用的程序语言就OK了！