Fórum erro na exportação p/ excel #313185

// Desenvolvido em Delphi5 e Excel.
// Fique à vontade para enviar sugestões de melhoria.

unit DecisionGridExcel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, mxgrid;

type
  TDecisionGridExcel = class(TComponent)
  private
    FFileName: TFileName;
    FSheetName: TFileName;
    FDecisionGrid: TDecisionGrid;
    FViewFile: Boolean;
    FOnBeforeExport: TNotifyEvent;
    FOnAfterExport: TNotifyEvent;
    FExportFormat: Boolean;
    procedure SetFileName(const Value: TFileName);
    procedure SetSheetName(const Value: TFileName);
    procedure SetDecisionGrid(const Value: TDecisionGrid);
    { Private declarations }
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    function SaveToXLS: Boolean;
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    property FileName: TFileName read FFileName write SetFileName;
    property SheetName: TFileName read FSheetName write SetSheetName;
    property DecisionGrid: TDecisionGrid read FDecisionGrid write SetDecisionGrid;
    property ViewFile: Boolean read FViewFile write FViewFile;
    property ExportFormat: Boolean read FExportFormat write FExportFormat;

    property OnBeforeExport: TNotifyEvent read FOnBeforeExport write FOnBeforeExport;
    property OnAfterExport: TNotifyEvent read FOnAfterExport write FOnAfterExport;
  end;

procedure Register;

implementation

uses ComObj, Excel97;

procedure Register;
begin
  RegisterComponents(´Decision Cube´, [TDecisionGridExcel]);
end;

{ TDecisionGridExcel }

constructor TDecisionGridExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FFileName := ´Pasta1´;
  FSheetName := ´Plan1´;
  FDecisionGrid := Nil;
  FOnBeforeExport := Nil;
  FOnAfterExport := Nil;
  FViewFile := False;
  FExportFormat := True;
end;

function TDecisionGridExcel.SaveToXLS: Boolean;
var
  e: Variant; 
  w: Variant; 
  s: Variant; 
  Row, Col: Integer;
  Options: TDecisionGridOptions;
  ir, ic, ifr, ifc: Integer;

  function EscreverCelula(DC {Coluna da Grade}, DR {Linha da Grade}: Integer;
                          EC {Coluna do Excel}, ER {Linha do Excel}: Integer): Boolean;
  var
    Valor: String;
    DST: TDecisionDrawState;
    Cell: Variant;
  begin
    Try
      Result := True;

      if FDecisionGrid.CellDrawState(DC, DR, Valor, DST) then
      begin
        Cell := s.Cells[ER, EC];

        Cell.HorizontalAlignment := xlCenter;

        Cell.EntireColumn.AutoFit;

        if (Trim(Valor) = ´´) then
          Cell.Value := ´ ´
        else Cell.Value := Valor;

        if FExportFormat then
        begin
          if (dsSum in DST) then
          begin
            Cell.Font.Bold := True;
            Cell.Interior.Color := ColorToRgb(FDecisionGrid.LabelSumColor);
          end
          else if (dsData in DST) then
            Cell.Interior.Color := ColorToRgb(FDecisionGrid.DataColor)
            else Cell.Interior.Color := ColorToRgb(FDecisionGrid.LabelColor);


          Cell.Borders[xlDiagonalDown].LineStyle := xlNone;
          Cell.Borders[xlDiagonalUp].LineStyle := xlNone;

          Cell.Borders[xlEdgeLeft].LineStyle := xlContinuous;
          Cell.Borders[xlEdgeLeft].Weight := xlThin;
          Cell.Borders[xlEdgeLeft].ColorIndex := xlAutomatic;

          Cell.Borders[xlEdgeTop].LineStyle := xlContinuous;
          Cell.Borders[xlEdgeTop].Weight := xlThin;
          Cell.Borders[xlEdgeTop].ColorIndex := xlAutomatic;

          Cell.Borders[xlEdgeBottom].LineStyle := xlContinuous;
          Cell.Borders[xlEdgeBottom].Weight := xlThin;
          Cell.Borders[xlEdgeBottom].ColorIndex := xlAutomatic;

          Cell.Borders[xlEdgeRight].LineStyle := xlContinuous;
          Cell.Borders[xlEdgeRight].Weight := xlThin;
          Cell.Borders[xlEdgeRight].ColorIndex := xlAutomatic;
        end;
      end
      else Result := False;
    Except
      On E: Exception do
      begin
        Result := False;

        ShowMessage(E.Message);
      end;
    end;
  end;
begin
  if not Assigned(FDecisionGrid) then
  begin
    Result := False;

    ShowMessage(´O objeto Decision Grid não está definido´);
    Exit;
  end;

  if (FDecisionGrid.RowCount = 0) then
  begin
    Result := False;

    Exit;
  end;

  Result := True;

  Try
    if Assigned(FOnBeforeExport) then FOnBeforeExport(Self);

    Options := FDecisionGrid.Options;
    FDecisionGrid.Options := FDecisionGrid.Options - [cgOutliner];
    Application.ProcessMessages;

    e := CreateOleObject(´Excel.Application´);

    //e.DisplayAlerts := False; {Discarta arquivo se não salvo}

    w := e.Workbooks.Add(xlWBatWorkSheet);
    w.WorkSheets[1].Name := FSheetName;

    s := w.WorkSheets[FSheetName];

    Row := 0;
    for ifr := FDecisionGrid.FixedRows downto 1 do
    begin
      Inc(Row);
      Col := 0;
      for ifc := FDecisionGrid.FixedCols downto 1 do
      begin
        Inc(Col);

        if Result then Result := EscreverCelula(-ifc, -ifr, Col, Row)
        else Break;
      end;
    end;

    {Vamos aos dados em si...}
    if Result then
      for ir := 0 to (FDecisionGrid.RowCount - FDecisionGrid.FixedRows - 1) do
        for ic := 0 to (FDecisionGrid.ColCount - FDecisionGrid.FixedCols - 1) do
        begin
          if (ir = 0) then
          begin
            Row := 0;
            for ifr := FDecisionGrid.FixedRows downto 1 do
            begin
              Inc(Row);

              if Result then Result := EscreverCelula(ic - ifc, ir - ifr, ic + FDecisionGrid.FixedCols + 1, Row {,})
              else Break;
            end;
          end;

          if (ic = 0) then
          begin
            Col := 0;
            for ifc := FDecisionGrid.FixedCols downto 1 do
            begin
              Inc(Col);

              if Result then Result := EscreverCelula(ic - ifc, ir - ifr, Col, ir + FDecisionGrid.FixedRows + 1)
              else Break;
            end;
          end;

          if Result then Result := EscreverCelula(ic, ir, ic + FDecisionGrid.FixedCols + 1, ir + FDecisionGrid.FixedRows + 1)
          else Break;
        end;{For ic := ....}

      if Assigned(FOnAfterExport) then FOnAfterExport(Self);
    Finally
      FDecisionGrid.Options := Options;
      Application.ProcessMessages;

      //e.DisplayAlerts := True; {Volta ao estado anterior}

      if Result then w.SaveAs(FFileName, xlNormal);

      if FViewFile and Result then e.Visible := True
      else e.Quit;
    end;
end;

procedure TDecisionGridExcel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation = opRemove) and (AComponent = FDecisionGrid) then FDecisionGrid := nil;
end;

procedure TDecisionGridExcel.SetDecisionGrid(const Value: TDecisionGrid);
begin
  if (Value <> FDecisionGrid) then FDecisionGrid := Value;
end;

procedure TDecisionGridExcel.SetSheetName(const Value: TFileName);
begin
  if (Trim(Value) <> ´´) and (FSheetName <> Value) then FSheetName := Value;
end;

procedure TDecisionGridExcel.SetFileName(const Value: TFileName);
begin
  if (Trim(Value) <> ´´) and (FFileName <> Value) then FFileName := Value;
end;

end.