请问如何把DBGrid组件中显示的数据存为excel文件？

Question

通过查询将所需数据用DBGrid控件显示，但如何保存到excel中呢？
另外TTable中有几个Findnearest的方法，但是在ADOTable中有没有类似的方法呢？
谢谢大家！

Answer 1

有个第三方控件可以的
TDBadvGrid,
advDbGrid.savetoxls(filename)

Answer 2

如果不要一些修饰的话
var  
  I: Integer;  
  Str: String;  
  StrList: TStringList;　　　//用于存储数据的字符列表
begin  
  StrList := TStringList.Create;  
  try    
    with AdoQuery1 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('xxx.xls');    
    end;    
  finally    
    StrList.Free;  
  end;
end;

Answer 3

Procedure TTech_XmbyycForm.BitBtnSaveClick(Sender: TObject);
Var
  EclApp, WorkBook: Variant;                        //声明为OLE Automation 对象
  XlsFileName, DirName: string;
  i, j, n: integer;
Begin
  DirName := ExtractFilePath(Application.ExeName);
  DirName := LeftStr(DirName, Length(DirName) - 5) + 'ExcelBook\';
  If not DirectoryExists(DirName) Then
    CreateDir(DirName);  SaveDialog1.InitialDir := DirName;
  SaveDialog1.Filter := 'Excel files(*.xls)|*.xls';
  If SaveDialog1.Execute = True Then
  Begin
    XlsFileName := SaveDialog1.FileName;
    Try
      EclApp := CreateOleObject('Excel.Application');
      //创建OLE对象Excel Application与 WorkBook
      WorkBook := CreateOleobject('Excel.Sheet');
    Except
      ShowMessage('您的机器里尚未安装Microsoft Excel。');
      Exit;
    End;    Try
      Application.MessageBox('将新建一个EXCEL文件,并保存',
        '注意', MB_OK + MB_Defbutton1)
    Finally
      ProgressBar1.Visible := True;
      WorkBook := EclApp.WorkBooks.Add;
      Tech_DataMForm.ADOQuery1.First;
      i := 1;
      j := 1;
      For n := 0 To Tech_DataMForm.ADOQuery1.FieldCount - 1 Do
      Begin
        EclApp.Cells(i, j) := DBGrid1.Columns.Items[n].Title.Caption;
        j := j + 1;
      End;
      Tech_DataMForm.ADOQuery1.First;
      While not Tech_DataMForm.ADOQuery1.EOF Do
      Begin
        Inc(i);
        For j := 0 To Tech_DataMForm.ADOQuery1.FieldCount - 1 Do
        Begin
          ProgressBar1.Position :=
            (i * 100) div Tech_DataMForm.ADOQuery1.RecordCount;
          EclApp.Cells(i, j + 1) :=
            Tech_DataMForm.ADOQuery1.Fields.Fields[j].Text;
        End;
        Tech_DataMForm.ADOQuery1.Next;
      End;
      ProgressBar1.Visible := False;
      WorkBook.SaveAs(XlsFileName);
      WorkBook.Close;
    End;
  End;
End;

Answer 4

我用DevExpress的cxGrid，它有相应的方法ExportToExcel

Answer 5

procedure GenXlsFile(DBGrid: TDBGrid; Fn: string; Vis: Boolean);
//uses ComObj;
var
  ExcelApp: Variant;
  i, j: integer;
begin
  try
    ExcelApp := CreateOleObject('Excel.Application');
  except
    application.MessageBox('系统中的MS Excel软件没有安装或安装不正确！', '错误', MB_ICONERROR + MB_OK);
    exit;
  end;
  ExcelApp.visible := vis;
  try
    excelapp.caption := '应用程序调用 Microsoft Excel';
    ExcelApp.WorkBooks.Add;
    //写入标题行
    for i := 1 to DBGrid.Columns.Count do //sDataSet.Fields.Count do
    begin
      //if DBGrid.Columns[i - 1].Visible then
      ExcelApp.Cells[1, i].Value := (DBGrid.Columns[i - 1].Title.Caption);
    end;
    DBGrid.DataSource.DataSet.First;
    i := 2;
    while not DBGrid.DataSource.DataSet.Eof do
    begin
      for j := 0 to DBGrid.Columns.Count - 1 do //sDataSet.Fields.Count-1 do
      begin
          //if DBGrid.Columns[j].Visible then
        ExcelApp.Cells[i, j + 1].Value := DBGrid.DataSource.DataSet.FieldByName(DBGrid.Columns[j].FieldName).AsString; //sDataSet.Fields[j].AsString;
      end;
      DBGrid.DataSource.DataSet.Next;
      i := i + 1;
    end;
    DBGrid.DataSource.DataSet.First;
    if application.MessageBox('数据导出完成.确认保存吗？', '问题', MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1 + MB_SYSTEMMODAL) = IDYES then
    begin
      if not ExcelApp.ActiveWorkBook.Saved then
        ExcelApp.ActiveWorkBook.SaveAs(fn);
    end
    else begin
      ExcelApp.ActiveWorkBook.Saved := True; //不保存
    end;
  finally
    excelapp.quit; //退出EXCEL软件
  end;
end;

Answer 6

procedure TForm1.ToExcel(MyQuery: TQuery);
Var
MsExcel, MsExcelWorkBook, MsExcelWorkSheet: Variant;
 i, j: Integer;
 SaveDia:TSaveDiaLog;
begin
 SaveDia:=Tsavedialog.Create(Self);
 SaveDia.Filter:='Excel檔案|*.Xls';
 If Myquery.Active Then
  Begin
   try
     MsExcel := CreateOleObject('Excel.Application');
     MsExcelWorkBook := MsExcel.WorkBooks.Add;
     MsExcelWorkSheet := MsExcel.WorkSheets.Add;
     MsExcel.Visible :=True;
     with MyQuery do
     begin
       For j := 0 to FieldCount - 1 Do
         MsExcelWorkSheet.Range[Chr(65 + j) + '1'].Value :=
           Fields[j].DisplayLabel;
       first;
       i := 2;
       While Not Eof Do
       begin
         for j := 0 to FieldCount - 1 do
           MsExcelWorkSheet.Range[Chr(65 + j) + IntToStr(i)].Value :=
             Fields[j].AsString;
         Inc(i);
         Application.ProcessMessages;
         Next;
       end;
     end;
     With SaveDia do
      If Execute then MsExcelWorkSheet.SaveAs(SaveDia.FileName);
   Finally
     MsExcel.Quit;
     SaveDia.Free;
   end;
  end;  

Answer 7

（Excel_str：是公共变量，保存文件名）
procedure Excel_name(AdoQuery: TADOQuery); //把数据导入Excel表格
var
 Sheets, columnRange: VAriant;
 i, j, z, k, m: integer;
 dyh: string;
begin
 dyh := '''';
 try
   begin
     if ADOQuery.IsEmpty then
     begin
       application.messagebox('数据表为空，不能打印！', '提示', Mb_ok + MB_ICONERROR);
       exit;
     end
     else
     begin
       XlApp := CreateOleObject('Excel.Application'); //创建ole对象
       Xlapp.Visible := True;
       Xlapp.Workbooks.Add(XlWbatWorkSheet);
       Xlapp.Workbooks[1].Worksheets[1].Name := Excel_str; //Excel名
       sheets := Xlapp.Workbooks[1].worksheets[Excel_str];
       sheets.cells[2, 2] := '星河软件股份有限公司(' + Excel_str + ')表';
       sheets.cells[2, 2].font.size := 26;
       sheets.cells[2, 2].font.bold := true;       for j := 0 to ADOQuery.fieldcount - 1 do
       begin
         sheets.cells[5, j + 1] := ADOQuery.fields[j].DisplayLabel;
         sheets.cells[5, j + 1].borders.lineStyle := XLContinuous;
       end;
       ColumnRange := Xlapp.workbooks[1].worksheets[Excel_str].columns;
       for k := 0 to ADOQuery.fieldcount - 1 do //设置各列的宽度
       begin
         if ADOQuery.fields[k].DataType in [ftstring, ftbytes] then
           Columnrange.columns[k + 1].columnWidth := ADoQuery.Fields[k].size + 2;
         if ADOQuery.fields[k].DataType in [ftdate, fttime, ftdateTime] then
           Columnrange.columns[k + 1].columnWidth := 16;
         if ADOQuery.fields[k].DataType in [ftCurrency, ftfloat, ftBCD] then
           Columnrange.columns[k + 1].columnWidth := 9;
         if ADOQuery.fields[k].DataType in [ftinteger, ftsmallint] then
           Columnrange.columns[k + 1].columnWidth := 5;
       end;
       ADOQuery.First;
       for i := 0 to ADOQuery.recordcount - 1 do //导出数据
       begin
         for z := 0 to AdoQuery.FieldCount - 1 do
           with ADOQuery do
           begin
             if ADOQuery.fields[z].DataType in [ftCurrency, ftfloat, ftBCD] then
               sheets.cells[i + 6, z + 1] := fields[z].asstring
             else
               sheets.cells[i + 6, z + 1] := dyh + fields[z].asstring;
             sheets.cells[i + 6, z + 1].borders.lineStyle := XLContinuous;
           end;
         ADOQuery.next;
       end;
       m := ADOQuery.recordcount;
       sheets.cells[4, 1] := '打印日期:';
       sheets.cells[4, 1].font.size := 10;
       sheets.cells[4, 1].font.bold := true;
       sheets.cells[4, 2] := dyh + datetostr(now);       sheets.cells[m + 7, 1] := '操作员:';
       sheets.cells[m + 7, 1].font.size := 10;
       sheets.cells[m + 7, 1].font.bold := true;
       sheets.cells[m + 7, 2] := Current_User;
     end;
   end;
 except
   on EDatabaseError do
   begin
     Application.MessageBox('数据库出错', '错误', MB_OK + MB_ICONERROR);
     Exit;
   end;
 else //try..except..on..else..
   begin
     Application.MessageBox('系统出错', '错误', MB_OK + MB_ICONERROR);
     Exit;
   end;
 end;
end;