TDBGridEh导出成*.xls文件

procedure DBGridToExcel(dbGrid: TDBGridEh ; fname: string);
const
  msoScaleFromTopLeft = $00000000;
  msoScaleFromMiddle = $00000001;
  msoScaleFromBottomRight = $00000002;
  msoTrue = $FFFFFFFF;
  msoFalse = $00000000;
var
  ExcelObj,  WorkBook, Sheet : OleVariant;
  OldCursor : TCursor;
  Row,Col, FieldIndex:Integer;

  dataset: TDataSet;
  SaveDialog : TSaveDialog;
  saveFileName: string;
begin
  { 如果数据集还未打开，就退出 }
  if (dbGrid.DataSource.DataSet = nil) or  (dbGrid.DataSource.DataSet.Active =False) or (dbGrid.DataSource.DataSet.RecordCount = 0) then
  begin
    MessageDlg('无数据！', mtWarning,[mbOK],0);
    abort;
  end;

    SaveDialog:=TSaveDialog.Create(Nil);
    saveDialog.FileName:= fname;
    //SaveDialog.Filter := 'Microsoft Excel 文件|*.xls';
    if SaveDialog.Execute then
    begin
      UpdateWindow(GetActiveWindow);
      saveFileName:= SaveDialog.FileName;
      SaveDialog.Free;
    end else
    begin
      SaveDialog.Free;
      exit;
    end;

  dataset:= dbGrid.DataSource.DataSet;

  { 保存当前的鼠标光标，
    然后把鼠标光标变成等待光标，表示下面的操作可能要化点时间 }
  OldCursor:=Screen.Cursor;
  Screen.Cursor:=crHourGlass;
  { 准备转换所需的Excel对象，如果失败，弹出提示 } 
  try
    ExcelObj := CreateOleObject('Excel.Sheet');
    //ExcelObj.Application.Visible := Visible ;   { 让Excel可不可见 }

    {这里没有用ExcelObj.Application.ActiveWorkBook是为了解决 
      Delphi中的OleVariant对象和实际的Excel对象的生存期冲突  } 
    WorkBook := ExcelObj.Application.Workbooks.Add ;

    Sheet:= WorkBook.Sheets[1];
    Sheet.Cells.Font.Size:=9;
    Sheet.Cells.Font.Name := 'Arial';
  except 
    MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+ 
                   '请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION); 
    Screen.Cursor:=OldCursor; 
    Exit; 
  end;

  try
    { 转换 ： 通过循环，先转换标题，然后转换表内容 }
    Sheet.Activate;

    // 列标题
    Row:=1;
    Col:=1;
    for FieldIndex:=0 to dbGrid.Columns.Count-1 do
    begin
      if (dbGrid.Columns[FieldIndex].Field <> nil) then
      begin
        Sheet.Cells[Row,Col]:=dbGrid.Columns[FieldIndex].Field.DisplayLabel;
        Sheet.Cells[Row,Col].Interior.Color   := RGB(191,191,191);
        Inc(Col);
      end;
    end;
    Sheet.Rows[1].Font.Bold := True;

    // 表内容
    DataSet.First;
    while not DataSet.Eof do
    begin
      Row:=Row+1;
      Col:=1;
      for FieldIndex:=0 to dbGrid.Columns.Count-1 do
      begin
        if (dbGrid.Columns[FieldIndex].Field <> nil) then
        begin
          if (dbGrid.Columns[FieldIndex].Field.DataType = ftString)
             or  (dbGrid.Columns[FieldIndex].Field.DataType = ftUnknown)
               or (dbGrid.Columns[FieldIndex].Field.DataType = ftWideString)  then
          begin
            Sheet.Cells[Row,Col].NumberFormatLocal:='@';  //设置文本格式
            if Length(dbgrid.Columns[FieldIndex].Field.AsString) > 30 then
              Sheet.Cells[Row,Col].WrapText := True; //自动换行
          end;

          Sheet.Cells[Row,Col]:=dbgrid.Columns[FieldIndex].Field.AsString;
          Inc(Col);
        end;
      end;

      DataSet.Next;
    end;

    WorkBook.SaveAs(FileName:= saveFileName);

    Application.MessageBox(' 数据已经成功导出到Excel中！','导出成功',MB_OK+MB_ICONINFORMATION);

  finally
    sheet:=UnAssigned;
    {这里没有用ExcelObj.Application.ActiveWorkBook是为了解决 
      Delphi中的OleVariant对象和实际的Excel对象的生存期冲突  }
    WorkBook := UnAssigned;
    ExcelObj := UnAssigned;

    Screen.Cursor:=OldCursor;   { 所有工作已完成，把鼠标光标变为原来的样子 }
  end;
end;

转载于:https://www.cnblogs.com/hsbs/p/4318124.html