在DELPHI 如何把MS SQL SERVER 数据转出成EXCEL表

Question

各位大虾，能帮忙告诉如何在将DBGRID网格中数据保存成EXCEL表 ，还请多多指教

Answer 1

用控件
ExcelApplication和
ExcelWorksheet和
ExcelWorkbook

Answer 2

借花献佛，一个叫copy_paste的人写的，，能用的话，就把分给人家吧unit ExportExcel;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB, DB, Excel2000;type
  TStatus = (stInitExcel, stOpenDataSet, stExportData, stSetFont, stSaveFile, stError);
  TExportStatus = procedure(Index: Integer; Status: TStatus) of object;
  TInitExcelBook = procedure(ExcelBook: TExcelWorkBook) of object;
  TExportSheet = function(const Index: Integer;
    out ASQLText: string; out AFieldName: Boolean;
    out AFontName: string; out AFontSize: Integer): Boolean of object;  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    FThread: TThread;
    procedure OnStatus(Index: Integer; Status: TStatus);
    procedure InitExcelBook(ExcelBook: TExcelWorkBook);
    function ExportSheet(const Index: Integer;
      out ASQLText: string; out AFieldName: Boolean;
      out AFontName: string; out AFontSize: Integer): Boolean;
  end;var
  Form1: TForm1;implementationuses ActiveX;
{$R *.dfm}type
  TDataSetToExcel = class(TThread)
  private
    FFileName: string;
    FDataSet: TADOQuery;
    FExcelBook: TExcelWorkBook;
    FExcelSheet: TExcelWorkSheet;
    FExcelApp: TExcelApplication;
    FOnExportSheet: TExportSheet;
    FOnInitExcelBook: TInitExcelBook;
    FOnStatus: TExportStatus;
    procedure DoStatus(Index: Integer; Status: TStatus);
    function GetAfterOpen: TDataSetNotifyEvent;
    procedure SetAfterOpen(Value: TDataSetNotifyEvent);
    function DoExportSheet(const Index: Integer;
      out ASQLText: string; out AFieldName: Boolean;
      out AFontName: string; out AFontSize: Integer): Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(AFileName: string; AADOConnString: string = '');
    destructor Destroy; override;
    property OnStatus: TExportStatus read FOnStatus write FOnStatus;
    property OnExportSheet: TExportSheet read FOnExportSheet write FOnExportSheet;
    property OnInitExcelBook: TInitExcelBook read FOnInitExcelBook write FOnInitExcelBook;
    property OnDataSetAfterOpen: TDataSetNotifyEvent read GetAfterOpen write SetAfterOpen;
  end;{ TDataSetToExcel }constructor TDataSetToExcel.Create;
begin
  FFileName := AFileName;
  FDataSet := TADOQuery.Create(nil);
  FDataSet.ConnectionString := AADOConnString;
  FExcelBook := TExcelWorkBook.Create(nil);
  FExcelSheet := TExcelWorkSheet.Create(nil);
  FExcelApp := TExcelApplication.Create(nil);
  FreeOnTerminate := True;
  inherited Create(True);
end;destructor TDataSetToExcel.Destroy;
begin
  FDataSet.Free;
  FExcelBook.Free;
  FExcelSheet.Free;
  FExcelApp.Free;
  inherited Destroy;
end;function TDataSetToExcel.DoExportSheet(const Index: Integer;
  out ASQLText: string; out AFieldName: Boolean;
  out AFontName: string; out AFontSize: Integer): Boolean;
begin
  Result := False;
  if Assigned(FOnExportSheet) then
    Result := FOnExportSheet(Index, ASQLText, AFieldName, AFontName, AFontSize);
end;procedure TDataSetToExcel.DoStatus(Index: Integer; Status: TStatus);
begin
  if Assigned(FOnStatus) then FOnStatus(Index, Status);
end;procedure TDataSetToExcel.Execute;
var
  FieldName: Boolean;
  SQLText, FontName: string;
  FontSize, Index, RowCount, ColCount: Integer;
begin
  CoInitialize(nil);
  try
    try
      FExcelApp.Visible[0] := False;
      try
        DoStatus(-1, stInitExcel);
        FExcelBook.ConnectTo(FExcelApp.Workbooks.Add(EmptyParam, 0));
        if Assigned(FOnInitExcelBook) then
          FOnInitExcelBook(FExcelBook);
      except
        raise Exception.Create('连接到Excel文件出错，可能是没有安装Excel软件');
      end;      try
        Index := 1;
        while DoExportSheet(Index, SQLText, FieldName, FontName, FontSize) do
        begin
          DoStatus(Index, stOpenDataSet);
          with FDataSet do
          begin
            if Active then Close;
            SQL.Text := SQLText;
            try
              Open; First;
              ColCount := FieldCount;
              RowCount := RecordCount;
            except
              raise Exception.Create('SQL语句出错.');
            end;
          end;          DoStatus(Index, stExportData);
          FExcelSheet.ConnectTo(FExcelBook.Worksheets[Index] as _WorkSheet);
          with FExcelSheet.QueryTables.Add(FDataSet.Recordset,
            FExcelSheet.Range['A2', EmptyParam], EmptyParam) do
          begin
            FieldNames := FieldName;
            Refresh(False);
          end;          DoStatus(Index, stSetFont);
          with FExcelSheet do
          begin
            with Range[Cells.Item[1, 1], Cells.Item[RowCount + 1, ColCount]] do
            begin
              Font.Name := FontName;
              Font.Size := FontSize;
            end;
            with Range[Cells.Item[1, 1], Cells.Item[RowCount + 1, ColCount]] do
              Borders.LineStyle := xlContinuous;
          end;
          Inc(Index);
        end;        DoStatus(-1, stSaveFile);
        FExcelBook.SaveCopyAs(FFileName);
        FExcelBook.Close(False);
      finally
        FExcelApp.Quit;
        FExcelSheet.Disconnect;
        FExcelBook.Disconnect;
        FExcelApp.Disconnect;
      end;
    except
      DoStatus(-1, stError);
    end;
  finally
    CoUnInitialize;
  end;
end;function TDataSetToExcel.GetAfterOpen: TDataSetNotifyEvent;
begin
  Result := FDataSet.AfterOpen;
end;procedure TDataSetToExcel.SetAfterOpen(Value: TDataSetNotifyEvent);
begin
  FDataSet.AfterOpen := Value;
end;const
  Conn =
    'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=dbname;Data Source=servername';{ TForm1 }//这里进行SQL语句，之类的设置。
function TForm1.ExportSheet(const Index: Integer; out ASQLText: string;
  out AFieldName: Boolean; out AFontName: string;
  out AFontSize: Integer): Boolean;
begin
  Result := Index <= 5;
  ASQLText := 'select * from ValueDictionary';
  AFieldName := False;
  AFontName := '宋体';
  AFontSize := 9;
end;// 初始化你的ExcelWorkBook
procedure TForm1.InitExcelBook(ExcelBook: TExcelWorkBook);
var
  Index: Integer;
  Sheet: _WorkSheet;
begin
  Index := ExcelBook.Worksheets.Count;
  while Index < 5 do
  begin
    Sheet := ExcelBook.Worksheets.Add(EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, 0) as _WorkSheet;
    Inc(Index);
  end;
  for Index := 1 to 5 do
    (ExcelBook.Sheets.Item[Index] as _WorkSheet).Name := IntToStr(Index);
end;procedure TForm1.Button1Click(Sender: TObject);
var
  Thread: TDataSetToExcel;
begin
  Thread := TDataSetToExcel.Create('c:\a.xls', Conn);
  Thread.OnStatus := OnStatus;
  Thread.OnExportSheet := ExportSheet;
  Thread.OnInitExcelBook := InitExcelBook;
  FThread := Thread;
  FThread.Resume;
end;// 工作状态
procedure TForm1.OnStatus(Index: Integer; Status: TStatus);
const
  S: array [TStatus] of string = ('stInitExcel', 'stOpenDataSet',
     'stExportData', 'stSetFont', 'stSaveFile', 'stError');
var
  E: Exception;
begin
  Memo1.Lines.Add(Format('Index: %d, Status: %s', [Index, S[Status]]));
  case Status of
    stSaveFile:
      FThread := nil;
    stError:
    begin
      E := Exception(ExceptObject);
      Memo1.Lines.Add(Format('Error: %s', [E.Message]));
    end;
  end;
end;end.

Answer 3

最好用dxdbgrid控件，
再加一个savedialog控件
 加入代码：
  if savedialog1.excute then
   begin
     dxdbgrid1.savetoxls(savedialog1.filename,true);
   end;

Answer 4

使用控间，有许多种，提供一种参考：EHlib.

Answer 5

呵呵，其实你可以方便一点这么来做啊！~~
首先在dbgrid中显示，然后在转化啊！~~~给你代码：导出excel 表：
uses　　comobj；
procedure Tregister.EXCEL1Click(Sender: TObject);
var       xlsFilename :string;
          eclApp,WorkBook :variant ;
          a_filedNo,i,j :integer;
begin
         a_filedNo :=register.DBGrid1.FieldCount ;
         xlsFileName :='关于注册人员信息.xls';         try
                  eclApp :=CreateOleObject('Excel.Application');
                  WorkBook :=CreateOleObject('Excel.Sheet');
         except
                  showmessage('您的系统没有安装MS EXCEL');
                  exit;
         end;         try
                    WorkBook :=eclApp.workBooks.add ;
                    for i :=1 to  a_FiledNo do      //转化字段名；
                     begin
                            eclApp.cells(1,i) :=register.DBGrid1.Fields[i-1].FieldName ;  
                     end;                    register.DBGrid1.DataSource.DataSet.First ; 
                    for i :=1 to  register.a_recordno do
                      begin
                            for j :=1 to  a_filedNo do  //转化一个记录
                              begin
                                      eclApp.cells(i+1,j) :=DbGrid1.Fields[j-1].Value ; 
                              end;
                            register.DBGrid1.DataSource.DataSet.Next ;
                      end;
                try
                     WorkBook.saveas(ExtractFilePath(Application.ExeName )+xlsFileName);
                     WorkBook.close;
                     showmessage('保存EXECL文件成功，路径为：'+ExtractFilePath(Application.ExeName )+xlsFileName);
                  except
                           showmessage('保存文件出错');
                  end;
               except
                 showmessage('不能正确操作EXECL文件，可能该文件已经被其他程序占用或系统错误');
                 WorkBook.close;
                 eclApp.quit;
                 eclApp :=Unassigned;
         end;end;