关于DBGridEH导出EXCEL,OFFICE2010无法打开的解决方案

放弃空间自带的导出方法,自己写导出方法,完美导出,代码如下

 

procedure TPublicToExcel.DBGridSaveXLS(aDBGrid: TDBGridEH;
  sFileName: string);
  function LineFeedsToXLS(s:string):string;
  var
    Res: string;
    i: Integer;
  begin
    Res := '';
    for i := 1 to Length(s) do
    if s[i] <> #13 then
      Res := Res + s[i];
      Result:=res;
  end;
var
  FExcel: Variant;
  FWorkbook: Variant;
  FWorksheet: Variant;
  FArray: Variant;
  s, z: Integer;
  RangeStr, sTitle: string;
  aBookMark: TBookMark;    //引用DB
  StrtCol,
  StrtRow,
  RowCount,
  ColCount: Integer;
begin
  Screen.Cursor := crHourGlass;
  try
    FExcel := CreateOleObject('Excel.Application');
  except
    Screen.cursor := crDefault;
    MessageDlg('Could not start Microsoft Excel!', mtError, [mbCancel], 0);
    Exit;
  end;
  aDBGrid.DataSource.DataSet.GetBookmark;
  aBookMark:= aDBGrid.DataSource.DataSet.GetBookMark;
  aDBGrid.DataSource.DataSet.DisableControls;
  try
    StrtCol := 0;
    StrtRow := 0;
    FWorkBook := FExcel.WorkBooks.Add;
    FWorkSheet := FExcel.WorkBooks[1].WorkSheets[1];
    RowCount := aDBGrid.DataSource.DataSet.RecordCount + 1;
    ColCount := aDBGrid.Columns.Count;
    FArray := VarArrayCreate([0, RowCount - 1 - StrtRow, 0, ColCount - 1 - StrtCol], VarVariant);
    for z := StrtCol to ColCount - 1 do
    begin
      sTitle := aDBGrid.Columns[z].Title.Caption;
      if sTitle = '' then
        sTitle := aDBGrid.Columns[z].FieldName;
      FArray[0, z - StrtCol] := LineFeedsToXLS(sTitle);
    end;
    s := 1;//s := StrtRow;
    aDBGrid.DataSource.DataSet.First;
    while not aDBGrid.DataSource.DataSet.Eof do
    begin
      for z := StrtCol to ColCount - 1 do
        FArray[s - StrtRow, z - StrtCol] := LineFeedsToXLS(aDBGrid.Columns[z].Field.DisplayText);
      Inc(s);
      aDBGrid.DataSource.DataSet.Next;
    end;
    RangeStr := 'A1:';
    if (ColCount - StrtCol) > 26 then
    begin
      if (ColCount - StrtCol) mod 26 = 0 then
      begin
        RangeStr := RangeStr + Chr(Ord('A') - 2 + ((ColCount - StrtCol) div 26));
        RangeStr := RangeStr + 'Z';
      end else
      begin
        RangeStr := RangeStr + Chr(Ord('A') - 1 + ((ColCount - StrtCol) div 26));
        RangeStr := RangeStr + Chr(Ord('A') - 1 + ((ColCount - StrtCol) mod 26));
      end;
    end else
    begin
      RangeStr := RangeStr + Chr(Ord('A') - 1 + (ColCount - StrtCol)); 
    end;
    RangeStr := RangeStr + IntToStr(RowCount - StrtRow);
    FWorkSheet.Range[RangeStr].Value := FArray;
    if sFileName <> '' then
    begin
      FWorkbook.SaveAs(sFileName);
      FExcel.Quit;
      FExcel := unAssigned;
    end else
    begin
      FExcel.Visible := True;
    end;
  finally
    aDBGrid.DataSource.DataSet.GotoBookMark(aBookMark);
    aDBGrid.DataSource.DataSet.EnableControls;
    aDBGrid.DataSource.DataSet.FreeBookMark(aBookMark);
    Screen.Cursor := crDefault;
  end;
end;

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值