获得当前窗体的DBGrid后导出Excel

Question

本帖最后由 zhangzhen_927116 于 2012-12-10 11:09:33 编辑

Answer 1

这有一个比人写的，我修改了一点点~~~供参考下：
unit DBGrid2Excel;interfaceuses
  Windows, Variants, Classes, SysUtils, Forms, DB, DBGrids, ComObj;type
  TUpAniInfoProc = procedure (const sInfo: string;Position,FullNum: Integer) of object;  function DBGridToExcel(dgrSource: TDBGrid;
          UpAniInfo: TUpAniInfoProc = nil; SaveFile: String = 'XyBook1.xls'): Integer;implementation
const
  MAX_SHEET_ROWS = 65536-1;  //Excel每Sheet最大行数
  MAX_VAR_ONCE   = 1000;     //一次导出的条数
function DBGridToExcel(dgrSource: TDBGrid; UpAniInfo: TUpAniInfoProc; SaveFile: String): Integer;
var          //从DBGrid导出到Excel(改进至可以导入几乎无限的数据)
  MyExcel, varCells: Variant;
  MySheet, MyCells, Cell1, Cell2, Range: OleVariant;
  iRow, iCol, iRealCol, iSheetIdx, iVarCount, iCurRow, iFieldCount: integer;
  CurPos: TBook;
  DataSet: TDataSet;
  sFieldName: string;
begin          //返回导出记录条数
  DataSet := dgrSource.DataSource.DataSet;  DataSet.DisableControls;
  CurPos  := DataSet.GetBook;
  DataSet.First;  MyExcel := CreateOleObject('Excel.Application');
  MyExcel.WorkBooks.Add;
  MyExcel.Visible := False;  if DataSet.RecordCount <= MAX_VAR_ONCE then
    iVarCount := DataSet.RecordCount
  else
    iVarCount := MAX_VAR_ONCE;  iFieldCount := dgrSource.Columns.Count;        //对DBGrid，只导出显示的列
  for iCol:=0 to dgrSource.Columns.Count-1 do
    if not dgrSource.Columns[iCol].Visible then  //可能有不显示的列
      Dec(iFieldCount);
  varCells  := VarArrayCreate([1,
                               iVarCount,
                               1,
                               iFieldCount], varVariant);
  iSheetIdx := 1;
  iRow      := 0;
  Result    := 0;
  while not DataSet.Eof do
  begin
    if (iRow = 0) or (iRow > MAX_SHEET_ROWS + 1) then
    begin          //新增一个Sheet
      if iSheetIdx <= MyExcel.WorkBooks[1].WorkSheets.Count then
        MySheet := MyExcel.WorkBooks[1].WorkSheets[iSheetIdx]
      else
        MySheet := MyExcel.WorkBooks[1].WorkSheets.Add(NULL, MySheet);//加在后面
      MyCells := MySheet.Cells;
      Inc(iSheetIdx);
      iRow := 1;      iRealCol := 0;
      for iCol := 1 to iFieldCount do
      begin
        MySheet.Cells[1, iCol].Font.Bold := True;
        {MySheet.Select;
        MySheet.Cells[iRow,iCol].Select;
        MyExcel.Selection.Font.Bold := true;}//这种方法也可(Sheet.Select不可少)
        while not dgrSource.Columns[iRealCol].Visible do
          Inc(iRealCol);          //跳过不可见的列
        MySheet.Cells[1, iCol] := dgrSource.Columns[iRealCol].Title.Caption;
        MySheet.Columns[iCol].ColumnWidth := //以下方法似乎算得还行
          Integer(Round(dgrSource.Columns[iRealCol].Width * 2
          / abs(dgrSource.Font.Height)));
        sFieldName := dgrSource.Columns[iRealCol].FieldName;
        if (DataSet.FieldByName(sFieldName).DataType = ftString)
          or (DataSet.FieldByName(sFieldName).DataType = ftWideString) then
        begin          //对于“字符串”型数据则设Excel单元格为“文本”型
          MySheet.Columns[iCol].NumberFormatLocal := '@';
        end;
        Inc(iRealCol);
      end;
      Inc(iRow);
    end;
    iCurRow := 1;
    while not DataSet.Eof do
    begin
      iRealCol := 0;
      for iCol := 1 to iFieldCount do
      begin
        while not dgrSource.Columns[iRealCol].Visible do
          Inc(iRealCol);          //跳过不可见的列
        sFieldName := dgrSource.Columns[iRealCol].FieldName;
        varCells[iCurRow, iCol] := DataSet.FieldByName(sFieldName).AsString;
        Inc(iRealCol);
      end;
      Inc(iRow);
      Inc(iCurRow);
      Inc(Result);
      DataSet.Next;
      if (iCurRow > iVarCount) or (iRow > MAX_SHEET_ROWS + 1) then
      begin
        if Assigned(UpAniInfo) then
          UpAniInfo(Format('(已导出%d条,共%d条)', [Result, DataSet.RecordCount]),Result, DataSet.RecordCount); //显示已导出条数
        Application.ProcessMessages;
        Break;
      end;
    end;
    Cell1 := MyCells.Item[iRow - iCurRow + 1, 1];
    Cell2 := MyCells.Item[iRow - 1,
          iFieldCount];
    Range := MySheet.Range[Cell1 ,Cell2];
    Range.Value := varCells;
    if (iRow > MAX_SHEET_ROWS + 1) then     //一个Sheet导出结束
    begin
      MySheet.Select;
      MySheet.Cells[1, 1].Select;    //使得每一Sheet均定位在第一格
    end;
    Cell1    := Unassigned;
    Cell2    := Unassigned;
    Range    := Unassigned;  end;  MyCells  := Unassigned;
  varCells := Unassigned;
  MyExcel.WorkBooks[1].WorkSheets[1].Select;   //必须先选Sheet
  MyExcel.WorkBooks[1].WorkSheets[1].Cells[1,1].Select;
  MyExcel.Visible := False;
//  MyExcel.WorkBooks[1].Saved := True;
  MyExcel.DisplayAlerts:= False;
  MyExcel.WorkBooks[1].SaveAs(SaveFile);
//  MyExcel.WorkBooks[1].SaveCopyAs(SaveFile);
////  调用Excel另存新档功能
////  MyExcel.Application.CommandBars.FindControl(ID:=748).Execute;
  MyExcel.Quit;
  MyExcel:= Unassigned;
  if CurPos <> nil then
  begin
    DataSet.GotoBook(CurPos);
    DataSet.FreeBook(CurPos);
  end;
  DataSet.EnableControls;
end;end.

Answer 2

用QExport控件去导出Excel,几行代码就行了……
另外，死守着DBGrid做啥呢？换功能更强大的DBGridEH或者cxgrid，直接用其自带的函数导出Excel，一行代码就够了……
当然，用2楼的代码也行，但要弄懂它起码要先了解delphi是怎么操作Excel的……

Answer 3

SaveDialog1.FileName := ''; //清空SaveDialog1默认文件名
  if SaveDialog1.Execute then
  begin //如果SaveDialog1正确执行
    pExpClass := TDBGridEhExportAsXLS; 
    pExt := 'xls';
    if pExpClass <> nil then //如果导出文件类型已经被正确设置
    begin
      pExpFile := trim(SaveDialog1.FileName);
      pExpFileExt := Copy(pExpFile, Length(pExpFile) - 2, 3); //判断返回的文件名称是否已经包含正确的扩展名,如果没有则添加正确的扩展名
      if UpperCase(pExpFileExt) <> UpperCase(pExt) then
        pExpFile := pExpFile + '.' + pExt;
      SaveDBGridEhToExportFile(pExpClass, DBGridEh2, pExpFile, True); //按现有设置导出全部数据。
      showmessage('导出成功');
    end;
  end;