關於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;

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章