请教各位大哥:
怎么把 dbgrid 中的数据插到入到 excel?祝 各位大哥端午节快乐!
 谢谢!

解决方案 »

  1.   

    我劝你还是连接excel,然后插入数据吧?
      

  2.   

    以 excel  为关键字在CSDN里搜索...能找到一大堆....
      

  3.   

    关于DBGRID数据导出到EXCEL 
    --------------------------------------------------------------\
    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;----------------------------------------------------------
    其实不用控件也不需要这么烦
    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;-----------------------------------------------把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; 
     
      

  4.   

    很简单的
    如果是简单的导出很简单的
    我给你一个d语言的procedure CopyDbDataToExcel(Target: TDbgrid;sheetname:string;filename:string);
    var
    iCount, jCount: Integer;
    XLApp: Variant;
    Sheet: Variant;
    begin
    Screen.Cursor := crHourGlass;
    if not VarIsEmpty(XLApp) then
    begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
    end;
    //通过ole创建Excel对象
    try
    XLApp := CreateOleObject('Excel.Application');
    except
    Screen.Cursor := crDefault;
    Exit;
    end;
    XLApp.WorkBooks.Add[filename];    //你要把数据放在那里
    XLApp.WorkBooks[1].WorkSheets[1].Name := sheetname;
    Sheet := XLApp.Workbooks[1].WorkSheets[XLApp.WorkBooks[1].WorkSheets[1].Name];
    if not Target.DataSource.DataSet.Active then
    begin
    Screen.Cursor := crDefault;
    Exit;
    end;
    Target.DataSource.DataSet.first;
    //ExcelWorkSheet1.Cells.NumberFormat :='@'for iCount := 0 to Target.Columns.Count - 1 do
    begin
    Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
    end;
    jCount := 1;
    while not Target.DataSource.DataSet.Eof do
    begin
    for iCount := 0 to Target.Columns.Count - 1 do
    begin
    Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
    end;
    Inc(jCount);
    Target.DataSource.DataSet.Next;
    end;
    XlApp.Visible := True;
    Screen.Cursor := crDefault;
    end;
    我程序里的一段
    procedure CopyDbDataToExcel(Target: TDbgrid;sheetname:string;filename:string);
    这些是传入函数
      

  5.   

    谢谢 各位大哥
    特别 是 Open2ye 大哥和  advancejar
      

  6.   

    advancejar  大哥:
                         您好!
    假设我单击  button2 就 需要 把 dbgrid1 里的数据 放到 表名为  myexcel 的excel  表中保存路径 为  C:\Documents and Settings\Administrator\My Documents\excel
    那么调用是这样的吗?procedure TForm1.Button2Click(Sender: TObject);
    begin
          CopyDbDataToExcel(dbgrid1,'myexcel','C:\Documents and Settings\Administrator\My Documents\excel');
    end;
    可是我单击  Button2 
    出现了这样的错误:不能访问只读文件 excel !advancejar  大哥 ,我那里做错误了呢?
    祝 advancejar  大哥 和各位大哥 端午节快乐!
      

  7.   

    procedure TForm1.Button1Click(Sender: TObject);
    var
      str:String;
      strlist:TStringList;
      i:Integer;
    begin
         DeleteFile('zg.xls');
         strlist:=TStringList.Create;
         ADOTable1.First;
            for i:=0 to ADOTable1.FieldCount-1 do
                str:=str+ADOTable1.Fields[i].FieldName+#9;   
                         
            strlist.Add(str);
            
             try
                 while not ADOTable1.Eof do
                 begin
                     str:='';
                     for i:=0 to ADOTable1.FieldCount-1 do
                         str:=Str+ADOTable1.Fields[i].AsString+#9;
                     strlist.Add(str);
                     ADOTable1.Next;
                     Application.ProcessMessages;
                end;
                strlist.SaveToFile('zg.xls');
                ShowMessage('OK');
            finally
                strlist.Free;
            end;
    end;
      

  8.   

    zjh527  大哥:
                   您好!
          'zg.xls'的具体路径是什么啊?谢谢!
      

  9.   

    用文件流处理很快的。
    做一个UNIT 然后使用
    代码如下:
    unit UnitXLSFile;
    interface
    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, 
    Dialogs,db,dbctrls,comctrls;
    const
    {BOF}
      CBOF      = $0009;
      BIT_BIFF5 = $0800;
      BOF_BIFF5 = CBOF or BIT_BIFF5;
    {EOF}
      BIFF_EOF = $000a;
    {Document types}
      DOCTYPE_XLS = $0010;
    {Dimensions}
      DIMENSIONS = $0000;
    type
      TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
                    acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);
      TSetOfAtribut = set of TatributCell;
      TXLSWriter = class(Tobject)
      private
        fstream:TFileStream;
        procedure WriteWord(w:word);
      protected
        procedure WriteBOF;
        procedure WriteEOF;
        procedure WriteDimension;
      public
        maxCols,maxRows:Word;
        procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
        procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
        procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
        procedure WriteField(vCol,vRow:word;Field:TField);
        constructor create(vFileName:string);
        destructor destroy;override;
      end;procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
    procedure DataSetToXLS(ds:TDataSet;fname:String);
    procedure StringGridToXLS(grid:TStringGrid;fname:String);implementationprocedure DataSetToXLS(ds:TDataSet;fname:String);
    var c,r:Integer;
      xls:TXLSWriter;
    begin
      xls:=TXLSWriter.create(fname);
      if ds.FieldCount > xls.maxcols then
        xls.maxcols:=ds.fieldcount+1;
      try
        xls.writeBOF;
        xls.WriteDimension;
        for c:=0 to ds.FieldCount-1 do
          xls.Cellstr(0,c,ds.Fields[c].DisplayLabel);
        r:=1;
        ds.first;
        while (not ds.eof) and (r <= xls.maxrows) do begin
          for c:=0 to ds.FieldCount-1 do
            if ds.Fields[c].AsString<>'' then
              xls.WriteField(r,c,ds.Fields[c]);
          inc(r);
          ds.next;
        end;
        xls.writeEOF;
      finally
        xls.free;
      end;
    end;procedure StringGridToXLS(grid:TStringGrid;fname:String);
    var c,r,rMax:Integer;
      xls:TXLSWriter;
    begin
      xls:=TXLSWriter.create(fname);
      rMax:=grid.RowCount;
      if grid.ColCount > xls.maxcols then
        xls.maxcols:=grid.ColCount+1;
      if rMax > xls.maxrows then          // &brvbar;&sup1;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;&brvbar;h&yen;u&macr;à&brvbar;s 65535 Rows
        rMax:=xls.maxrows;
      try
        xls.writeBOF;
        xls.WriteDimension;
        for c:=0 to grid.ColCount-1 do
          for r:=0 to rMax-1 do
            xls.Cellstr(r,c,grid.Cells[c,r]);
        xls.writeEOF;
      finally
        xls.free;
      end;
    end;{ TXLSWriter }constructor TXLSWriter.create(vFileName:string);
    begin
      inherited create;
      if FileExists(vFilename) then
        fStream:=TFileStream.Create(vFilename,fmOpenWrite)
      else
        fStream:=TFileStream.Create(vFilename,fmCreate);  maxCols:=100;   // <2002-11-17> dllee Column &Agrave;&sup3;&cedil;&Oacute;&not;O¤&pound;&yen;i&macr;à¤j&copy;ó 65535, &copy;&Ograve;&yen;H¤&pound;&brvbar;A&sup3;B&sup2;z
      maxRows:=65535; // <2002-11-17> dllee &sup3;o&shy;&Oacute;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;¤j&yen;u&macr;à&sup3;o&raquo;ò¤j&iexcl;A&frac12;&ETH;&ordf;`·N¤j&ordf;&ordm;&cedil;ê&reg;&AElig;&reg;w&laquo;&Uuml;&reg;e&copy;&ouml;&acute;N¤j&copy;ó&sup3;o&shy;&Oacute;&shy;&Egrave;
    end;destructor TXLSWriter.destroy;
    begin
      if fStream <> nil then
        fStream.free;
      inherited;
    end;procedure TXLSWriter.WriteBOF;
    begin
      Writeword(BOF_BIFF5);
      Writeword(6);           // count of bytes
      Writeword(0);
      Writeword(DOCTYPE_XLS);
      Writeword(0);
    end;procedure TXLSWriter.WriteDimension;
    begin
      Writeword(DIMENSIONS);  // dimension OP Code
      Writeword(8);           // count of bytes
      Writeword(0);           // min cols
      Writeword(maxRows);     // max rows
      Writeword(0);           // min rowss
      Writeword(maxcols);     // max cols
    end;procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
      vAtribut: TSetOfAtribut);
    var  FAtribut:array [0..2] of byte;
    begin
      Writeword(3);           // opcode for double
      Writeword(15);          // count of byte
      Writeword(vCol);
      Writeword(vRow);
      SetCellAtribut(vAtribut,fAtribut);
      fStream.Write(fAtribut,3);
      fStream.Write(aValue,8);
    end;procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
    var  FAtribut:array [0..2] of byte;
    begin
      Writeword(2);           // opcode for word
      Writeword(9);           // count of byte
      Writeword(vCol);
      Writeword(vRow);
      SetCellAtribut(vAtribut,fAtribut);
      fStream.Write(fAtribut,3);
      Writeword(aValue);
    end;procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: String;
      vAtribut: TSetOfAtribut);
    var  FAtribut:array [0..2] of byte;
      slen:byte;
    begin
      Writeword(4);           // opcode for string
      slen:=length(avalue);
      Writeword(slen+8);      // count of byte
      Writeword(vCol);
      Writeword(vRow);
      SetCellAtribut(vAtribut,fAtribut);
      fStream.Write(fAtribut,3);
      fStream.Write(slen,1);
      fStream.Write(aValue[1],slen);
    end;procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
    var
       i:integer;
    begin
     //reset
      for i:=0 to High(FAtribut) do
        FAtribut[i]:=0;
         if  acHidden in value then       //byte 0 bit 7:
             FAtribut[0] := FAtribut[0] + 128;     if  acLocked in value then       //byte 0 bit 6:
             FAtribut[0] := FAtribut[0] + 64 ;     if  acShaded in value then       //byte 2 bit 7:
             FAtribut[2] := FAtribut[2] + 128;     if  acBottomBorder in value then //byte 2 bit 6
             FAtribut[2] := FAtribut[2] + 64 ;     if  acTopBorder in value then    //byte 2 bit 5
             FAtribut[2] := FAtribut[2] + 32;     if  acRightBorder in value then  //byte 2 bit 4
             FAtribut[2] := FAtribut[2] + 16;     if  acLeftBorder in value then   //byte 2 bit 3
             FAtribut[2] := FAtribut[2] + 8;     if  acLeft in value then         //byte 2 bit 1
             FAtribut[2] := FAtribut[2] + 1
         else if  acCenter in value then  //byte 2 bit 1
             FAtribut[2] := FAtribut[2] + 2
         else if acRight in value then    //byte 2, bit 0 dan bit 1
             FAtribut[2] := FAtribut[2] + 3
         else if acFill in value then     //byte 2, bit 0
             FAtribut[2] := FAtribut[2] + 4;
    end;procedure TXLSWriter.WriteWord(w: word);
    begin
      fstream.Write(w,2);
    end;procedure TXLSWriter.WriteEOF;
    begin
      Writeword(BIFF_EOF);
      Writeword(0);
    end;procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
    begin
      case field.DataType of
         ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
           Cellstr(vcol,vrow,field.asstring);
         ftAutoInc,ftSmallint,ftInteger,ftWord:
           CellWord(vcol,vRow,field.AsInteger);
         ftFloat, ftBCD:
           CellDouble(vcol,vrow,field.AsFloat);
      else
           Cellstr(vcol,vrow,EmptyStr);
      end;
    end;
    end.
      

  10.   

    fhuibo  大哥:
                     您好!        if rMax > xls.maxrows then          // &brvbar;&sup1;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;&brvbar;h&yen;u&macr;à&brvbar;s 65535 这里是怎么写的,我复制到我的程序里,编译时有错,& 是什么意思啊?  //  是在注释 &brvbar;&sup1;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;&brvbar;h&yen;u&macr;à&brvbar;s 65535 这一行的吗?还有是,当我单击 button1 ,就要把数据 倒入到 excel  ,请教 fhuibo  大哥,我在 Button1Click  事件里需要写哪些东西呢?
    谢谢!
      

  11.   

    brvbar;&sup1;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;&brvbar;h&yen;u&macr;à&brvbar;s 65535 Rows
        rMax:=xls.maxrows;那个  Rows 有没有用的啊?谢谢!
      

  12.   

    zjh527  大哥:
                   您好!
          'zg.xls'的具体路径是什么啊?谢谢!
    ==========================================='zg.xls'其实他的路径默认就是和你这个应用程序在同一个目录下。
    你也可以写成:strlist.SaveToFile(ExtractFilePath(Application.ExeName)+'zg.xls')
      

  13.   

    procedure TForm1.Button1Click(Sender: TObject);
    var strlist:tstringlist;
        str:string;
        i:integer;
        path:string;
    begin
      savedialog1.DefaultExt:='xls';
      savedialog1.Filter:=combobox2.Text;
      if savedialog1.Execute then
        path:=savedialog1.FileName;
      if path='' then abort;
      strlist:=tstringlist.Create;
      with adoquery1 do
      begin
        close;
        sql.Clear;
        sql.Add('select * from xs');
        execsql;
        open
      end;
      progressbar1.Max:=adoquery1.RecordCount;
      progressbar1.Position:=0;
      while not adoquery1.Eof do
      begin
        str:='';
        for i:=0 to adoquery1.FieldCount-1 do
          str:=str+adoquery1.Fields[i].AsString+#9;
        strlist.Add(str);
        progressbar1.StepBy(1);
        adoquery1.Next;
      end;
      strlist.SaveToFile(path);
      showmessage('done');
      strlist.Free;end;这是我写的,xls,doc,wps随便导
    呵呵,