unit dbgrid2excel;
{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：DBGridToExcel([DBGrid1, DBGrid2]);
对于数字用AsString, 其它可能含有格式的文本用DisplayText
长数字字符 的Tag  C_LongNumber_FieldTag = 9; 避免科学计算格式，如身份证号的显示
自动采用对齐属性, 标题粗体

      
}
interface
uses
  classes, comctrls, stdctrls, windows, Dialogs, controls, SysUtils,
  Db,DBGrids,forms,ComObj,Variants;
const
  C_LongNumber_FieldTag = 9;
//这些不可运算文字可能含有格式
function MayHasFormatText(const AFieldType:TFieldType):Boolean;
procedure DBGridToExcel(Args: array of const);
implementation
function MayHasFormatText(const AFieldType:TFieldType):Boolean;
begin
  Result := AFieldType in
    [ftBoolean,  ftDate, ftTime, ftDateTime, ftTimeStamp,
     ftString,  ftFixedChar, ftWideString] ;
end;

{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：DBGridToExcel([DBGrid1, DBGrid2]);
}
procedure DBGridToExcel(Args: array of const);
const
  xlHAlignCenter = -4108;
  xlHAlignLeft  = -4131;
  xlHAlignRight  = -4152;
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
  BK : TBookMark;
  DataSet:TDataSet;
  Col : TColumn;
  CellStr : string;
  GAL :TAlignment;
  EAL : 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;
    DataSet := TDBGrid(Args[I].VObject).DataSource.DataSet;
    DataSet.DisableControls;
    BK := DataSet.GetBookmark();
    DataSet.First;
    //标题
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
    begin
      Col := TDBGrid(Args[I].VObject).Columns.Items[iCount];
      Sheet.Cells[1, iCount + 1] := Col.Title.Caption;
      Sheet.Cells[1, iCount + 1].Font.Bold :=True ;//粗体
      GAL := Col.Alignment;
      if GAL = taLeftJustify then
        EAL := xlHAlignLeft
      else if GAL = taCenter then
        EAL := xlHAlignCenter
      else EAL := xlHAlignRight;
      //列数据对齐格式
      Sheet.Columns[iCount + 1].HorizontalAlignment := EAL ;
      //列标题对齐格式
      Sheet.Cells[1, iCount + 1].HorizontalAlignment := xlHAlignCenter;
      //自定义格式, 避免把长数字字符转换为科学记数法
      if Col.Field.Tag=C_LongNumber_FieldTag then
        Sheet.Columns[iCount + 1].NumberFormatLocal :='@';
    end;
    //数据
    jCount := 1;
    while not DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      begin
        Col := TDBGrid(Args[I].VObject).Columns.Items[iCount];
        if MayHasFormatText(Col.Field.DataType) then
          CellStr := Col.Field.DisplayText
        else
          CellStr:=  Col.Field.AsString;
        Sheet.Cells[jCount + 1, iCount + 1] := CellStr;
      end;
      Inc(jCount);
      DataSet.Next;
      Application.ProcessMessages;
    end;
    DataSet.GotoBookmark(BK);
    DataSet.FreeBookmark(BK);
    DataSet.EnableControls;
    XlApp.Visible := True; //用户关掉, 就可以关掉内存中的Excel试验通过2005.2.5
    Sheet := unAssigned;   //可以不要
  end;
  Screen.Cursor := crDefault;
end; 

end.