比如一个AODQuery select 出来的数据怎么转化成excel?

解决方案 »

  1.   

    procedure TFormfunction.gridtoexcel(sheetname,tablehead:string;DBGridvar:Tdbgrid;toexcel:boolean);
    var //将dbgrid里的内容导入excel表格里。
        bm: TBook;
        col, row: Integer;
        sline: String;
        mem: TMemo;
        ExcelApp: Variant;
    begin
        Screen.Cursor := crHourglass;
        DBGridvar.DataSource.DataSet.DisableControls;
        bm := DBGridvar.DataSource.DataSet.GetBook;
        DBGridvar.DataSource.DataSet.First;
        // First we send the data to a memo 
        // works faster than doing it directly to Excel
        mem := TMemo.Create(Self);
        mem.Visible := false;
        mem.Parent := self;
        mem.Clear;
        sline := '';
        sline:=tablehead ;
        mem.lines.Add(sline);
        sline:='';
        // add the info for the column names
        for col := 0 to DBGridvar.FieldCount-1 do
          sline := sline + DBGridvar.Columns[col].Title.Caption+ #9;
        mem.Lines.Add(sline);
        // get the data into the memo 
        for row := 0 to DBGridvar.DataSource.DataSet.RecordCount-1 do
        begin
          sline := '';
          for col := 0 to DBGridvar.FieldCount-1 do
            sline := sline + DBGridvar.Fields[col].AsString + #9;
          mem.Lines.Add(sline);
          DBGridvar.DataSource.DataSet.Next;
          if col>=300 then
          begin
              showmessage('最多只能导出300条记录!');
              break;
          end;
        end;
      
        // we copy the data to the clipboard 
        mem.SelectAll; 
        mem.CopyToClipboard;    // if needed, send it to Excel
        // if not, we already have it in the clipboard
        if toExcel then
        begin
          ExcelApp := CreateOleObject('Excel.Application');
          ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
          if sheetname='' then
          sheetname:='sheet1';
          ExcelApp.WorkBooks[1].WorkSheets[1].Name := sheetname;
          ExcelApp.Workbooks[1].WorkSheets[sheetname].Paste;
          ExcelApp.Visible := true;
        end;
      
        FreeAndNil(mem);
      //  FreeAndNil(ExcelApp);
        DBGridvar.DataSource.DataSet.GotoBook(bm);
        DBGridvar.DataSource.DataSet.FreeBook(bm);
        DBGridvar.DataSource.DataSet.EnableControls;
        Screen.Cursor := crDefault;
    end;
      

  2.   

    1.select语句中可以写成类似select * into [excel 8.0;database=d:\aaa.xls].aa from aa,直接导出,速度很快,不过格式不好
    2.可以用内存数据集的方法,速度还可以,支持格式设置,可以给你看我写的一段vb代码,自己想想怎么转delphi吧
     Set excelapp = CreateObject("Excel.Application")
    With excelapp
    .Workbooks.Open App.Path & "\汇总表\" & fn
    rst.Open "select trim(村名) as 村名1,户数,混和户数,生活光户数,动力户数,水力户数,非居光户数,商业户数,供电量,总电量," & _
                             "0 as 抄见损失,生活光量,生活光费,非居光量,非居光费,动力电量,动力电费,水力电量,水力电费,商业电量,商业电费,总电费 from 所汇总 order by 标记", DE.cnn, adOpenStatic, adLockReadOnly, adCmdText
    Set excelsheet = .Sheets(rstSuo!局端所名 & rqqj(i))
                    With excelsheet
                      .Cells(1, 1) = Left(rqqj(i), 4) & "年" & CInt(Mid(rqqj(i), 5)) & "月" & juName & "体改村用电经营情况统计表(" & rstSuo!局端所名 & ")"
                      .Range("a4").CopyFromRecordset rst
     j = rst.RecordCount + 4 - 1
                      .Range("k4:k" & j).FormulaR1C1 = "=if(rc[-2]=0,"""",round((rc[-2]-rc[-1])/rc[-2]*100,2))"
                      .Range("w4:w" & j).FormulaR1C1 = "=if(rc[-14]=0,"""",round(rc[-1]/rc[-14],2))"
                    End With
     rst.Close
          .ActiveWorkbook.Close True
          .Quit
    end with
    3.写单元格,巨慢,例子很多,自己搜
      

  3.   

    来自:yzhshi, 时间:2001-12-2 10:04:00, ID:758347 
    [code]
    既然大家都在这里将自己的东西贴出来,那我就再贴一个,将DBGrid中的文件转换到Excel中或者转换到Txt中的控件。
    我自己编写的,希望大家讨论一下。
    unit DBGridExport;
    interface
    uses
      SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls, Db, DBGrids, Comobj, extctrls, comctrls, ActiveX;type
      TSpaceMark = (csComma, csSemicolon, csTab, csBlank, csEnter);  TDBGridExport = class(TComponent)
      private
        FDB_Grid: TDBGrid;                      {读取DBGrid的源}
        FTxtFileName: string;                      {文本文件名}
        FSpaceMark: TSpaceMark;               {间隔符号}
        FSpace_Ord: Integer;                {间隔符号的Asc数值}
        FTitle: string;                    {显示的标题}
        FSheetName: string;                        {工作表标题}
        FExcel_Handle: OleVariant;          {Excel的句柄}    FWorkbook_Handle: OleVariant;      {书签的句柄}
        FShow_Progress: Boolean;           {否显示插入进度}    FProgress_Form: TForm;                {进度窗体}
        FRun_Excel_Form: TForm;                {启动Excel提示窗口}
        FProgressBar: TProgressBar;         {进度条}    function Connect_Excel: Boolean;       {启动Excel}
        function New_Workbook: Boolean;        {插入新的工作博}
        function InsertData_To_Excel: Boolean;     {插入数据}
        procedure Create_ProgressForm(AOwner: TComponent);   {创建进度显示窗口}
        procedure Create_Run_Excel_Form(AOwner: TComponent);  {创建启动Excel窗口}
      procedure SetSpaceMark(Value: TSpaceMark);  {设置导出时的间隔符号}
      protected
      public
        constructor Create(AOwner: TComponent); override;       {新建}
        destructor Destroy; override;                           {销毁}
        function Export_To_Excel: Boolean; overload;            {导出到Excel中}
        function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload;
        function Export_To_Txt(NewFile: Boolean = True): Boolean; overload; {导出到文本文件中}
        function Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean; overload;
        function Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
        function Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;  published
        property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid;
        property Show_Progress: Boolean read FShow_Progress write FShow_Progress;
        property TxtFileName: string read FTxtFileName write FTxtFileName;
        property SpaceMark: TSpaceMark read FSpaceMark write SetSpaceMark;
        property Title: string read FTitle write FTitle;
        property SheetName: string read FSheetName write FSheetName;  end;
    procedure Register;
    implementation
    procedure Register;
    begin
      RegisterComponents('Stone', [TDBGridExport]);
    end;{-------------------------------------------------------------------------------}
    {新建}
    constructor TDBGridExport.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      FShow_Progress := True;
      FSpaceMark := csTab;
    end;{销毁}
    destructor TDBGridExport.Destroy;
    begin
      varClear(FExcel_Handle);
      varClear(FWorkbook_Handle);
      inherited Destroy;
    end;
    {===============================================================================}
    {导出到文本文件中}
    function TDBGridExport.Export_To_Txt(NewFile: Boolean = True): Boolean;
    var
      Txt: TStrings;
      Tmp_Str: string;
      data_Str: string;
      i, j: Integer;
      Column_name: string;
      Data_Set: TDataSet;
      book: pointer;
      Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
    begin
      Result := False;
      if NewFile = True then
        FTxtFileName := '';
      if FTxtFileName = '' then
      begin
        with TSaveDialog.Create(nil) do
        begin
          Title := '请选择输出文件名';
          DefaultExt := 'txt';
          Filter := '文本文件(*.Txt)|*.txt';
          Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing];
          if Execute then
            FTxtFileName := FileName;
          Free;
          if FTxtFileName = '' then                             {如果没有选中文件,则直接推出}
            exit;
        end;    if FTxtFileName = '' then
        begin
          raise exception.Create('没有指定输出文件');
          Exit;
        end;  end;  if FDB_Grid = nil then
        raise exception.Create('请输入DBGrid名称');  Txt := TStringList.Create;
      try
        {显示插入进度}
        if FShow_Progress = True then
        begin
          Create_ProgressForm(nil);
          FProgress_Form.Show;
        end;    {第一行,插入标题}
        Tmp_Str := '';                                          //FDB_Grid.Columns[0].Title.Caption;
        for i := 1 to FDB_Grid.Columns.Count do
          if FDB_Grid.Columns[i - 1].Visible = True then
            Tmp_Str := Tmp_Str + FDB_Grid.Columns[i - 1].Title.Caption + Chr(FSpace_Ord);
        Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
        Txt.Add(Tmp_Str);
       {插入DBGrid中的数据}
        Data_Set := FDB_Grid.DataSource.DataSet;
       {记忆当前位置并取消任何事件}
    //  new(book);
        book := Data_Set.GetBook;
        Data_Set.DisableControls;
        Before_Scroll := Data_Set.BeforeScroll;
        Afrer_Scroll := Data_Set.AfterScroll;
        Data_Set.BeforeScroll := nil;
        Data_Set.AfterScroll := nil;
        if FShow_Progress = True then
        begin
          Data_Set.Last;
          FProgress_Form.Refresh;
          FProgressBar.Max := Data_Set.RecordCount;
        end;
        {插入DBGrid中的所有字段}
        Data_Set.First;
        j := 2;
        while not Data_Set.Eof do
        begin
          if FShow_Progress = True then
            FProgressBar.Position := j - 2;
          Column_name := FDB_Grid.Columns[0].FieldName;      Tmp_Str := '';                                        //Data_Set.FieldByName(Column_name).AsString;
          for i := 1 to FDB_Grid.Columns.Count do
            if FDB_Grid.Columns[i - 1].Visible = True then
            begin
              data_Str := FDB_Grid.Fields[i - 1].DisplayText;
              Tmp_Str := Tmp_Str + data_Str + Chr(FSpace_Ord);
            end;
          Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
          Txt.Add(Tmp_Str);
          j := j + 1;
          Data_Set.Next;
        end;
        {恢复原始事件以及标志位置}
        Data_Set.GotoBook(book);
        Data_Set.FreeBook(book);
    //  dispose(book);
        Data_Set.EnableControls;
        Data_Set.BeforeScroll := Before_Scroll;
        Data_Set.AfterScroll := Afrer_Scroll;
        {写到文件}
        Txt.SaveToFile(FTxtFileName);
        Result := True;
      finally
        Txt.Free;
        if FShow_Progress = True then
        begin
          FProgress_Form.Free;
          FProgress_Form := nil;
        end;
      end;
    end;function TDBGridExport.Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean;
    begin
      FTxtFileName := FileName;
      Result := Export_To_Txt(NewFile);
    end;function TDBGridExport.Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
    begin
      FDB_Grid := DB_Grid;
      Result := Export_To_Txt(NewFile);
    end;function TDBGridExport.Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
    begin
      FTxtFileName := FileName;
      FDB_Grid := DB_Grid;
      Result := Export_To_Txt(NewFile);
    end;{-------------------------------------------------------------------------------}
    {设置导出时的间隔符号}
    procedure TDBGridExport.SetSpaceMark(Value: TSpaceMark);
    begin
      FSpaceMark := Value;
      case Value of
        csComma: FSpace_Ord := ord(',');
        csSemicolon: FSpace_Ord := ord(';');
        csTab: FSpace_Ord := 9;
        csBlank: FSpace_Ord := 32;
        csEnter: FSpace_Ord := 13;
      end;
    end;
      

  4.   

    {导出到Excel中}
    function TDBGridExport.Export_To_Excel: Boolean;
    begin
      if FDB_Grid = nil then
        raise exception.Create('请输入DBGrid名称');
      Result := False;
      if Connect_Excel = True then
        if New_Workbook = True then
          if InsertData_To_Excel = True then
            Result := True;
    end;
    function TDBGridExport.Export_To_Excel(DB_Grid: TDBGrid): Boolean;
    begin
      FDB_Grid := DB_Grid;
      Result := Export_To_Excel;
    end;
    {启动Excel}
    function TDBGridExport.Connect_Excel: Boolean;
      function My_GetActiveOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean; {连接Ole对象}
     var                    //IDispatch
        ClassID: TCLSID;
        Unknown: IUnknown;
        l_Result: HResult;
      begin
        Result := False;
        l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
        if (l_Result and $80000000) = 0 then
        begin
          l_Result := GetActiveObject(ClassID, nil, Unknown);
          if (l_Result and $80000000) = 0 then
          begin
            l_Result := Unknown.QueryInterface(IDispatch, Ole_Handle);
            if (l_Result and $80000000) = 0 then
              Result := True;
          end;
        end;
      end;
      
      function My_CreateOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;{创建OLE对象}
      var
        ClassID: TCLSID;
        l_Result: HResult;
      begin
        Result := False;
        l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
        if (l_Result and $80000000) = 0 then
        begin
          l_Result := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
            CLSCTX_LOCAL_SERVER, IDispatch, Ole_Handle);
          if (l_Result and $80000000) = 0 then
            Result := True;
        end;
      end;
    var
      l_Excel_Handle: IDispatch;
    begin
      if FShow_Progress = True then
      begin
        Create_Run_Excel_Form(nil);
        FRun_Excel_Form.Show;
      end;
      if My_GetActiveOleObject('Excel.Application', l_Excel_Handle) = False then
        if My_CreateOleObject('Excel.Application', l_Excel_Handle) = False then
        begin
          FRun_Excel_Form.Free;
          FRun_Excel_Form := nil;
          raise exception.Create('启动Excel失败,可能没有安装Excel!');
          Result := False;
          Exit;
        end;
      FExcel_Handle := l_Excel_Handle;
      if FShow_Progress = True then
      begin
        FRun_Excel_Form.Free;
        FRun_Excel_Form := nil;
      end;
      Result := True;
    end;
    function TDBGridExport.New_Workbook: Boolean;{插入新的工作博}
    var
      i: Integer;
    begin
      Result := True;
      try
        FWorkbook_Handle := FExcel_Handle.Workbooks.Add;
      except
        raise exception.Create('新建Excel工作表出错!');
        Result := False;
        Exit;
      end;
      if FTitle <> '' then
        FWorkbook_Handle.Application.ActiveWindow.Caption := FTitle;
      if FSheetName <> '' then
      begin
        for i := 2 to FWorkbook_Handle.Sheets.Count do
          if FSheetName = FWorkbook_Handle.Sheets[i].Name then
          begin
            raise exception.Create('工作表命名重复!');
            Result := False;
            exit;
          end;
        try
          FWorkbook_Handle.Sheets[1].Name := FSheetName;
        except
          raise exception.Create('工作表命名错误!');
          Result := False;
          exit;
        end;
      end;
    end;
    function TDBGridExport.InsertData_To_Excel: Boolean;{插入数据}
    var
      i, j, k: Integer;
      data_Str: string;
      Column_name: string;
      Data_Set: TDataSet;
      book: pointer;
      Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
    begin
      try
            if FShow_Progress = True then {显示插入进度}
        begin
          Create_ProgressForm(nil);
          FProgress_Form.Show;
        end;
        j := 1;    {第一行,插入标题}{仅仅插入可见数据}
        for i := 1 to FDB_Grid.Columns.Count do
          if FDB_Grid.Columns[i - 1].Visible = True then
          begin
            FWorkbook_Handle.WorkSheets[1].Cells[1, j].Value := FDB_Grid.Columns[i - 1].Title.Caption;
            FWorkbook_Handle.WorkSheets[1].Columns[j].ColumnWidth := FDB_Grid.Columns[i - 1].Width div 6;
            j := j + 1
          end;
        Data_Set := FDB_Grid.DataSource.DataSet;   {插入DBGrid中的数据}
    //  new(book);   {记忆当前位置并取消任何事件}
        book := Data_Set.GetBook;
        Data_Set.DisableControls;
        Before_Scroll := Data_Set.BeforeScroll;
        Afrer_Scroll := Data_Set.AfterScroll;
        Data_Set.BeforeScroll := nil;
        Data_Set.AfterScroll := nil;
        if FShow_Progress = True then
        begin
          Data_Set.Last;
          FProgress_Form.Refresh;
          FProgressBar.Max := Data_Set.RecordCount;
        end;
        Data_Set.First;
        k := 2;
        while not Data_Set.Eof do
        begin
          if FShow_Progress = True then
            FProgressBar.Position := k;
          j := 1;
          for i := 1 to FDB_Grid.Columns.Count do
          begin
            if FDB_Grid.Columns[i - 1].Visible = True then
            begin
              Column_name := FDB_Grid.Columns[i - 1].FieldName;
              data_Str := FDB_Grid.Fields[i - 1].DisplayText;
              FWorkbook_Handle.WorkSheets[1].Cells[k, j].Value := data_Str;
              j := j + 1;
            end;
          end;
          k := k + 1;
          Data_Set.Next;
        end;
        Data_Set.GotoBook(book);    {恢复原始事件以及标志位置}
        Data_Set.FreeBook(book);
    //  dispose(book);
        Data_Set.EnableControls;
        Data_Set.BeforeScroll := Before_Scroll;
        Data_Set.AfterScroll := Afrer_Scroll;
        Result := True;
      finally
        FExcel_Handle.Visible := True;
        FExcel_Handle.Application.ScreenUpdating := True;
        if FShow_Progress = True then
        begin
          FProgress_Form.Free;
          FProgress_Form := nil;
        end;
      end;
    end;
    {=======================}
    {启动Excel时给出进度显示}
    procedure TDBGridExport.Create_Run_Excel_Form(AOwner: TComponent);
    var
      Panel: TPanel;
      Prompt: TLabel;     {提示的标签}
    begin
      if assigned(FRun_Excel_Form) then exit;
      FRun_Excel_Form := TForm.Create(AOwner);
      with FRun_Excel_Form do
      begin
        try
          Font.Name := '宋体';      {设置字体}
          Font.Size := 9;
          BorderStyle := bsNone;
          Width := 300;
          Height := 100;
          BorderWidth := 2;
          Color := clBlue;
          Position := poScreenCenter;
          Panel := TPanel.Create(FRun_Excel_Form);
          with Panel do
          begin
            Parent := FRun_Excel_Form;
            Align := alClient;
            BevelInner := bvNone;
            BevelOuter := bvRaised;
            Caption := '';
          end;
          Prompt := TLabel.Create(Panel);
          with Prompt do
          begin
            Parent := panel;
            AutoSize := True;
            Left := 25;
            Top := 25;
            Caption := '正在导出数据,请稍候……';
          end;
        except
        end;
      end;
    end;
    {======================}
    {创建进度显示窗口}
    procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent);
    var
      Panel: TPanel;
      Prompt: TLabel;     {提示的标签}
    begin
      if assigned(FProgress_Form) then exit;  FProgress_Form := TForm.Create(AOwner);
      with FProgress_Form do
      begin
        try
          Font.Name := '宋体';     {设置字体}
          Font.Size := 9;
          BorderStyle := bsNone;
          Width := 300;
          Height := 100;
          BorderWidth := 2;
          Color := clBlue;
          Position := poScreenCenter;
          Panel := TPanel.Create(FProgress_Form);
          with Panel do
          begin
            Parent := FProgress_Form;
            Align := alClient;
            BevelInner := bvNone;
            BevelOuter := bvRaised;
            Caption := '';
          end;
          Prompt := TLabel.Create(Panel);
          with Prompt do
          begin
            Parent := panel;
            AutoSize := True;
            Left := 25;
            Top := 25;
            Caption := '正在导出数据,请稍候……';
          end;
          FProgressBar := TProgressBar.Create(panel);
          with FProgressBar do
          begin
            Parent := panel;
            Left := 20;
            Top := 50;
            Height := 18;
            Width := 260;
          end;
        except
        end;
      end;
    end;
    end.
      

  5.   

    从dataset导入的方法--------------------------------------------------------------------------------
    作者:8chen8  来源:  类别:delphi-数据库开发  日期:  今日/总浏览: 1/33  
      uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ComCtrls, Buttons, StdCtrls, ExtCtrls, DB, DBTables,Excel2000,OleServer,ComObj, 
    Grids, DBGrids, DBCtrls; 
    var 
    myexcel:variant; 
    workbook:olevariant; 
    worksheet:olevariant; 
    begin 
    try 
    myexcel:=createoleobject('excel.application'); 
    myexcel.application.workbooks.add; 
    myexcel.caption:=q+'至'+w+'客情预订表'; 
    myexcel.application.visible:=true; 
    workbook:=myexcel.application.workbooks[1]; 
    worksheet:=workbook.worksheets.item[1]; 
    except 
    showmessage('EXCEL不存在!'); 
    end; 
    i:=1; 
    j:=4; 
    if q<>w then 
    worksheet.Cells(i,j):=q+'至'+w+'客情预订表' 
    else 
    worksheet.Cells(i,j):=q+'客情预订表'; 
    i:=2; //EXECL表行号 
    n:=0;//query字段N序号 
    j:=1;//EXECL表列号 
    form23.Query1.First; 
    for n:=0 to form23.Query1.FieldCount -1 do 
    begin 
    worksheet.Cells(i,j):=form23.Query1.fields[n].DisplayLabel; 
    j:=j+1; 
    end; 
    i:=2; //EXECL表行号 
    n:=0;//query字段N序号 
    i:=2;//EXECL表行号 i:=2; 
    form23.query1.first; 
    while not form23.query1.eof do 
    begin 
    inc(i); 
    for j:=0 to form23.query1.fieldcount-1 do 
    worksheet.cells[i,j+1]:=form23.query1.fields[j].asstring; 
    form23.query1.next; 
    end;