fpspreadsheet: Implement simplest 3D cell references (single cells on any sheet within the same workbook). No reading for xls so far, writing is ok. Reading/writing to xlsx and ods ok.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6398 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/source/common/fpsexprparser.pas

@@ -57,7 +57,8 @@ type
   { Tokens }
 
   TsTokenType = (
-    ttCell, ttCellRange, ttNumber, ttString, ttIdentifier,
+    ttCell, ttSheetCell, ttCellRange, ttSheetName,
+    ttNumber, ttString, ttIdentifier,
     ttPlus, ttMinus, ttMul, ttDiv, ttConcat, ttPercent, ttPower, ttLeft, ttRight,
     ttLessThan, ttLargerThan, ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual,
     ttListSep, ttTrue, ttFalse, ttMissingArg, ttError, ttEOF
@@ -578,8 +579,18 @@ type
     property CallBack: TsExprFunctionEvent read FCallBack;
   end;
 
-  { TsCellExprNode }
+  TsSheetNameExprNode = class(TsExprNode)
-  TsCellExprNode = class(TsExprNode)
+  private
+    FSheetName: String;
+  public
+    constructor Create(AParser: TsExpressionParser; ASheetName: String);
+    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
+    function AsString: string; override;
+    property SheetName: String read FSheetName;
+  end;
+
+  { TsBasicCellExprNode }
+  TsBasicCellExprNode = class(TsExprNode)
   private
     FWorksheet: TsWorksheet;
     FRow, FCol: Cardinal;
@@ -587,21 +598,38 @@ type
     FCell: PCell;
     FIsRef: Boolean;
   protected
+    procedure Check; override;
     function GetCol: Cardinal;
     function GetRow: Cardinal;
     procedure GetNodeValue(out Result: TsExpressionResult); override;
   public
-    constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
-      ACellString: String); overload;
     constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
       ARow, ACol: Cardinal; AFlags: TsRelFlags); overload;
-    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
-    function AsString: string; override;
-    procedure Check; override;
     function NodeType: TsResultType; override;
     property Worksheet: TsWorksheet read FWorksheet;
   end;
 
+  { TsCellExprNode }
+  TsCellExprNode = class(TsBasicCellExprNode)
+  public
+    constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
+      ACellString: String); overload;
+    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
+    function AsString: string; override;
+  end;
+
+  { TsSheetCellExprNode }
+  TsSheetCellExprNode = class(TsBasicCellExprNode)
+  protected
+    function GetSheetIndex: Integer;
+  public
+    constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
+      ACellString: String); overload;
+    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
+    function AsString: string; override;
+  end;
+
+
   { TsCellRangeExprNode }
 
   TsCellRangeIndex = 1..2;
@@ -636,6 +664,8 @@ type
     FChar: PChar;
     FToken: String;
     FTokenType: TsTokenType;
+    FSheetNameTerminator: Char;
+    FSavedSheetNameTerminator: Char;
   private
     FParser: TsExpressionParser;
     function GetCurrentChar: Char;
@@ -646,7 +676,7 @@ type
     function DoIdentifier: TsTokenType;
     function DoNumber: TsTokenType;
     function DoDelimiter: TsTokenType;
-    function DoSquareBracket: TsTokenType;
+//    function DoSquareBracket: TsTokenType;
     function DoString: TsTokenType;
     function NextPos: Char; // inline;
     procedure SkipWhiteSpace; // inline;
@@ -662,6 +692,7 @@ type
     property Source: String read FSource write SetSource;
     property Pos: Integer read FPos;
     property CurrentChar: Char read GetCurrentChar;
+    property SheetnameTerminator: char read FSheetNameTerminator write FSheetNameTerminator;
   end;
 
   EExprScanner = class(Exception);
@@ -692,6 +723,7 @@ type
     function GetRPNFormula: TsRPNFormula;
 //    function MatchNodes(Todo, Match: TsExprNode): TsExprNode;
     procedure SetBuiltIns(const AValue: TsBuiltInExprCategories);
+    procedure SetDialect(const AValue: TsFormulaDialect);
     procedure SetIdentifiers(const AValue: TsExprIdentifierDefs);
     procedure SetRPNFormula(const AFormula: TsRPNFormula);
 
@@ -750,7 +782,7 @@ type
     property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns;
 //    property ActiveCell: PCell read FActiveCell write FActiveCell;
     property Worksheet: TsWorksheet read FWorksheet;
-    property Dialect: TsFormulaDialect read FDialect write FDialect;
+    property Dialect: TsFormulaDialect read FDialect write SetDialect;
   end;
 
   TsSpreadsheetParser = class(TsExpressionParser)
@@ -920,6 +952,8 @@ constructor TsExpressionScanner.Create(AParser: TsExpressionParser);
 begin
   Source := '';
   FParser := AParser;
+  FSheetnameTerminator := '!';
+  FSavedSheetNameTerminator := '!';
 end;
 
 function TsExpressionScanner.DoDelimiter: TsTokenType;
@@ -988,15 +1022,30 @@ var
   S: String;
   row, row2: Cardinal;
   col, col2: Cardinal;
+  sheetName: String;
   flags: TsRelFlags;
 begin
   C := CurrentChar;
-  while (not IsWordDelim(C)) and (C <> cNull) do
+  sheetName := '';
+  while (not IsWordDelim(C)) and (C <> cNull) and (C <> FSheetNameTerminator) do
   begin
+    if ((FParser.Dialect = fdOpenDocument) and (C = ']')) then begin
+      C := NextPos;
+      FSheetNameTerminator := FSavedSheetNameTerminator;
+      break;
+    end;
     FToken := FToken + C;
     C := NextPos;
   end;
-  S := LowerCase(Token);
+
+  if C = FSheetNameTerminator then
+  begin
+    C := NextPos;
+    result := ttSheetName;
+    exit;
+  end;
+
+  S := LowerCase(FToken);
   if ParseCellString(S, row, col, flags) and (C <> '(') then
     Result := ttCell
   else if ParseCellRangeString(S, row, col, row2, col2, flags) and (C <> '(') then
@@ -1033,7 +1082,7 @@ begin
     ScanError(Format(rsInvalidNumber, [FToken]));
   Result := ttNumber;
 end;
-
+                                    (*
 { Scans until closing square bracket is reached. In OpenDocument, this is
   a cell or cell range identifier. }
 function TsExpressionScanner.DoSquareBracket: TsTokenType;
@@ -1042,21 +1091,29 @@ var
   r1,c1,r2,c2: Cardinal;
   flags: TsRelFlags;
   isRange: Boolean;
+  sheetName: String;
 begin
   isRange := false;
   FToken := '';
+  sheetName := '';
   C := NextPos;
   while (C <> ']') do
   begin
     case C of
       cNull: ScanError(rsUnexpectedEndOfExpression);
-      '.'  : ; // ignore
+      '.'  : begin
+               sheetName := FToken;
+               FToken := '';
+             end;
       ':'  : begin isRange := true; FToken := FToken + C; end;
       else   FToken := FToken + C;
     end;
     C := NextPos;
   end;
   C := NextPos;
+
+  if sheetName <> '' then begin
+
   if isRange then
   begin
     if ParseCellRangeString(FToken, r1, c1, r2, c2, flags) then
@@ -1072,7 +1129,8 @@ begin
       Result := ttError;
 //      ScanError(Format(SErrInvalidCell, [FToken]));
   end;
-end;
+end;*)
+
 
 function TsExpressionScanner.DoString: TsTokenType;
 
@@ -1117,8 +1175,13 @@ begin
   FToken := '';
   SkipWhiteSpace;
   C := FChar^;
-  if (FParser.Dialect = fdOpenDocument) and (C = '[') then
+  if (FParser.Dialect = fdOpenDocument) and (C = '[') then begin
-    Result := DoSquareBracket
+    FSavedSheetNameTerminator := FSheetNameTerminator;
+    FSheetNameTerminator := '.';
+    C := NextPos;
+    Result := DoIdentifier
+//    Result := DoSquareBracket
+  end
   else if C = cNull then
     Result := ttEOF
   else if IsDelim(C) then
@@ -1598,6 +1661,7 @@ var
   optional: Boolean;
   token: String;
   prevTokenType: TsTokenType;
+  sheetname: String;
 begin
 {$ifdef debugexpr} Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
   SetLength(Args, 0);
@@ -1619,6 +1683,16 @@ begin
     Result := TsConstExprNode.CreateString(self, CurrentToken)
   else if (TokenType = ttCell) then
     Result := TsCellExprNode.Create(self, FWorksheet, CurrentToken)
+  else if (TokenType = ttSheetName) then begin
+    sheetName := CurrentToken;
+    GetToken;
+    if TokenType = ttCell then
+      Result := TsSheetCellExprNode.Create(self, FWorksheet.Workbook.GetWorksheetByName(sheetName), CurrentToken)
+  end
+  (*
+  else if (TokenType = ttSheetCell) then
+    Result := TsSheetCellExprNode.Create(self, FWorksheet.Workbook, CurrentToken)
+    *)
   else if (TokenType = ttCellRange) then
     Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken)
   else if (TokenType = ttError) then
@@ -1743,6 +1817,20 @@ begin
   Result := BuildStringFormula(AFormatSettings);
 end;
 
+procedure TsExpressionParser.SetDialect(const AValue: TsFormulaDialect);
+begin
+  if FDialect = AValue then exit;
+  FDialect := AValue;
+  {
+  if FScanner <> nil then
+    case FDialect of
+      fdExcelA1, fdExcelR1C1: FScanner.SheetNameTerminator := '!';
+      fdOpenDocument: FScanner.Sheetnameterminator := '.';
+      else raise Exception.Create('TsExpressionParser.SetDialect: Dialect not supported.');
+    end;
+    }
+end;
+
 procedure TsExpressionParser.SetExpression(const AValue: String);
 var
   fs: TFormatSettings;
@@ -3503,19 +3591,28 @@ begin
 end;
 
 
-{ TsCellExprNode }
+{ TsSheetNameExprNode }
-
+constructor TsSheetNameExprNode.Create(AParser: TsExpressionParser;
-constructor TsCellExprNode.Create(AParser: TsExpressionParser;
+  ASheetName: string);
-  AWorksheet: TsWorksheet; ACellString: String);
-var
-  r, c: Cardinal;
-  flags: TsRelFlags;
 begin
-  ParseCellString(ACellString, r, c, flags);
+  FParser := AParser;
-  Create(AParser, AWorksheet, r, c, flags);
+  FSheetName := ASheetName;
 end;
 
-constructor TsCellExprNode.Create(AParser: TsExpressionParser;
+function TsSheetNameExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
+begin
+  Result := ANext;
+end;
+
+function TsSheetnameExprNode.AsString: string;
+begin
+  Result := '';
+end;
+
+
+{ TsBasicCellExprNode }
+
+constructor TsBasicCellExprNode.Create(AParser: TsExpressionParser;
   AWorksheet: TsWorksheet; ARow,ACol: Cardinal; AFlags: TsRelFlags);
 begin
   FParser := AParser;
@@ -3526,29 +3623,7 @@ begin
   FCell := AWorksheet.FindCell(FRow, FCol);
 end;
 
-function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
+procedure TsBasicCellExprNode.Check;
-begin
-  if FIsRef then
-    Result := RPNCellRef(GetRow, GetCol, FFlags, ANext)
-  else
-    Result := RPNCellValue(GetRow, GetCol, FFlags, ANext);
-end;
-
-function TsCellExprNode.AsString: string;
-begin
-  case FParser.Dialect of
-    fdExcelA1      : Result := GetCellString(GetRow, GetCol, FFlags);
-    fdExcelR1C1    : Result := GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
-    fdOpenDocument : Result := '[.' + GetCellString(GetRow, GetCol, FFlags) + ']';
-  end;
-  {
-  Result := GetCellString(GetRow, GetCol, FFlags);
-  if FParser.Dialect = fdOpenDocument then
-    Result := '[.' + Result + ']';
-  }
-end;
-
-procedure TsCellExprNode.Check;
 begin
   // Nothing to check;
 end;
@@ -3563,14 +3638,14 @@ end;
       address of the SourceCell.
   (2) Normal mode:
       Returns the "true" row address of the cell assigned to the formula node. }
-function TsCellExprNode.GetCol: Cardinal;
+function TsBasicCellExprNode.GetCol: Cardinal;
 begin
   Result := FCol;
   if FParser.CopyMode and (rfRelCol in FFlags) then
     Result := FCol - FParser.FSourceCell^.Col + FParser.FDestCell^.Col;
 end;
 
-procedure TsCellExprNode.GetNodeValue(out Result: TsExpressionResult);
+procedure TsBasicCellExprNode.GetNodeValue(out Result: TsExpressionResult);
 var
   cell: PCell;
 begin
@@ -3593,20 +3668,114 @@ begin
   Result.Worksheet := FWorksheet;
 end;
 
-{ See GetCol }
+{ See: GetCol }
-function TsCellExprNode.GetRow: Cardinal;
+function TsBasicCellExprNode.GetRow: Cardinal;
 begin
   Result := FRow;
   if Parser.CopyMode and (rfRelRow in FFlags) then
     Result := FRow - FParser.FSourceCell^.Row + FParser.FDestCell^.Row;
 end;
 
-function TsCellExprNode.NodeType: TsResultType;
+function TsBasicCellExprNode.NodeType: TsResultType;
 begin
   Result := rtCell;
 end;
 
 
+{ TsSheetCellExprNode }
+
+constructor TsSheetCellExprNode.Create(AParser: TsExpressionParser;
+  AWorksheet: TsWorksheet; ACellString: String);
+var
+  r, c: Cardinal;
+  flags: TsRelFlags;
+  p: Integer;
+  sheetname: String;
+begin
+  (*
+  case AParser.Dialect of
+    fdExcelA1, fdExcelR1C1: p := pos('!', ACellString);
+    fdOpendocument: p := pos('.', ACellString);
+    else raise Exception.Create('TsSheetCellExprNode: Parser dialect not supported.');
+  end;
+  sheetname := copy(ACellString, 1, p-1);
+  ACellString := copy(ACellString, p+1, MaxInt);
+  *)
+  ParseCellString(ACellString, r, c, flags);
+  Create(AParser, AWorksheet, r, c, flags);
+end;
+
+function TsSheetCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
+begin
+  if FIsRef then
+    Result := RPNCellRef3D(GetSheetIndex, GetRow, GetCol, FFlags, ANext)
+  else
+    Result := RPNCellValue3D(GetSheetIndex, GetRow, GetCol, FFlags, ANext);
+end;
+
+function TsSheetCellExprNode.AsString: String;
+begin
+  case FParser.Dialect of
+    fdExcelA1:
+      Result := Format('%s!%s', [
+        FWorksheet.Name,
+        GetCellString(GetRow, GetCol, FFlags)
+      ]);
+    fdExcelR1C1:
+      Result := Format('%s!%s', [
+        FWorksheet.Name,
+        GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col)
+      ]);
+    fdOpenDocument:
+      Result := Format('[%s.%s]', [
+        FWorksheet.Name,
+        GetCellString(GetRow, GetCol, FFlags)
+      ]);
+    else
+      raise Exception.Create('TsSheetCellExprNode: Parser dialect not supported.');
+  end;
+end;
+
+function TsSheetCellExprNode.GetSheetIndex: Integer;
+var
+  book: TsWorkbook;
+begin
+  book := FWorksheet.Workbook;
+  Result := book.GetWorksheetIndex(FWorksheet);
+end;
+
+
+{ TsCellExprNode }
+
+constructor TsCellExprNode.Create(AParser: TsExpressionParser;
+  AWorksheet: TsWorksheet; ACellString: String);
+var
+  r, c: Cardinal;
+  flags: TsRelFlags;
+begin
+  ParseCellString(ACellString, r, c, flags);
+  Create(AParser, AWorksheet, r, c, flags);
+end;
+
+function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
+begin
+  if FIsRef then
+    Result := RPNCellRef(GetRow, GetCol, FFlags, ANext)
+  else
+    Result := RPNCellValue(GetRow, GetCol, FFlags, ANext);
+end;
+
+function TsCellExprNode.AsString: string;
+begin
+  case FParser.Dialect of
+    fdExcelA1      : Result := GetCellString(GetRow, GetCol, FFlags);
+    fdExcelR1C1    : Result := GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
+    fdOpenDocument : Result := '[.' + GetCellString(GetRow, GetCol, FFlags) + ']';
+  end;
+end;
+
+
+
 { TsCellRangeExprNode }
 
 constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;

components/fpspreadsheet/source/common/fpsopendocument.pas

@@ -110,6 +110,7 @@ type
     function FindNumFormatByName(ANumFmtName: String): Integer;
     function FindRowStyleByName(AStyleName: String): Integer;
     function FindTableStyleByName(AStyleName: String): Integer;
+    procedure FixFormulas;
     procedure ReadCell(ANode: TDOMNode; ARow, ACol: Integer;
       AFormatIndex: Integer; out AColsRepeated: Integer);
     procedure ReadColumns(ATableNode: TDOMNode);
@@ -1423,6 +1424,52 @@ begin
   Result := -1;
 end;
 
+procedure TsSpreadOpenDocReader.FixFormulas;
+
+  procedure FixCell(ACell: PCell);
+  var
+    parser: TsSpreadsheetParser;
+  begin
+    parser := TsSpreadsheetParser.Create(TsWorksheet(ACell^.Worksheet));
+    try
+      try
+        parser.Dialect := fdOpenDocument;
+        parser.LocalizedExpression[FPointSeparatorSettings] := ACell^.FormulaValue;
+        parser.Dialect := fdExcelA1;
+        ACell^.FormulaValue := parser.Expression;
+      except
+        on E:EExprParser do
+          begin
+            FWorkbook.AddErrorMsg(E.Message);
+            ACell^.FormulaValue := '';
+            if (boAbortReadOnFormulaError in Workbook.Options) then raise;
+          end;
+        on E:ECalcEngine do
+          begin
+            Workbook.AddErrorMsg(E.Message);
+            ACell^.FormulaValue := '';
+            if (boAbortReadOnFormulaError in Workbook.Options) then raise;
+          end;
+      end;
+    finally
+      parser.Free;
+    end;
+  end;
+
+var
+  i: Integer;
+  sheet: TsWorksheet;
+  cell: PCell;
+begin
+  if (boIgnoreFormulas in FWorkbook.Options) then
+    exit;
+  for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
+    sheet := FWorkbook.GetWorksheetByIndex(i);
+    for cell in sheet.Cells do
+      if HasFormula(cell) then FixCell(cell);
+  end;
+end;
+
 procedure TsSpreadOpenDocReader.ReadAutomaticStyles(AStylesNode: TDOMNode);
 var
   nodeName: String;
@@ -2370,6 +2417,7 @@ begin
       end;
       Delete(formula, 1, p);
     end;
+    (*
     if not (boIgnoreFormulas in FWorkbook.Options) then
     begin
       // ... convert to Excel "A1" dialect used by fps by defailt
@@ -2398,8 +2446,13 @@ begin
         parser.Free;
       end;
     end;
+    *)
     // ... and store in cell's FormulaValue field.
     cell^.FormulaValue := formula;
+    // Note: This formula is still in OpenDocument dialect. Conversion to
+    // Because fpsspreadsheet supports references to other sheets which might
+    // not have been loaded at this moment, conversion to ExcelA1 dialect
+    // (used by fps) is postponed until all sheets are read.
   end;
 
   // Read formula results
@@ -2608,6 +2661,9 @@ begin
       XMLStream.Free;
     end;
 
+    // Convert formulas from OpenDocument to ExcelA1 dialect
+    FixFormulas;
+
     // Active sheet
     if FActiveSheet <> '' then
       sheet := FWorkbook.GetWorksheetByName(FActiveSheet) else

components/fpspreadsheet/source/common/fpsrpn.pas

@@ -51,6 +51,8 @@ function RPNCellRange(ARow, ACol, ARow2, ACol2: Integer; AFlags: TsRelFlags;
   ANext: PRPNItem): PRPNItem; overload;
 function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags;
   ANext: PRPNItem): PRPNItem;
+function RPNCellValue3D(ASheet, ARow, ACol: Integer; AFlags: TsRelflags;
+  ANext: PRPNItem): PRPNItem;
 function RPNCellRef3D(ASheet, ARow, ACol: Integer; AFlags: TsRelFlags;
   ANext: PRPNItem): PRPNItem;
 function RPNCellRange3D(ASheet1, ARow1, ACol1, ASheet2, ARow2, ACol2: Integer;
@@ -259,6 +261,18 @@ begin
   Result^.Next := ANext;
 end;
 
+function RPNCellValue3D(ASheet, ARow, ACol: Integer; AFlags: TsRelflags;
+  ANext: PRPNItem): PRPNItem;
+begin
+  Result := NewRPNItem;
+  Result^.FE.ElementKind := fekCell3d;
+  Result^.FE.Sheet := ASheet;
+  Result^.FE.Row := ARow;
+  Result^.FE.Col := ACol;
+  Result^.FE.RelFlags := AFlags;
+  Result^.Next := ANext;
+end;
+
 function RPNCellRef3D(ASheet, ARow, ACol: Integer; AFlags: TsRelFlags;
   ANext: PRPNItem): PRPNItem;
 begin

components/fpspreadsheet/source/common/fpstypes.pas

@@ -166,7 +166,7 @@ type
   TFEKind = (
     { Basic operands }
     fekCell, fekCellRef, fekCellRange, fekCellOffset,
-    fekCellRef3d, fekCellRange3d,
+    fekCell3d, fekCellRef3d, fekCellRange3d,
     fekNum, fekInteger, fekString, fekBool, fekErr, fekMissingArg,
     { Basic operations }
     fekAdd, fekSub, fekMul, fekDiv, fekPercent, fekPower, fekUMinus, fekUPlus,

components/fpspreadsheet/source/common/xlsbiff8.pas

@@ -189,6 +189,8 @@ type
       out AContinueInString: Boolean): Boolean;
     function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
       AFlags: TsRelFlags): word; override;
+    function WriteRPNCellAddress3D(AStream: TStream; ASheet, ARow, ACol: Cardinal;
+      AFlags: TsRelFlags): Word; override;
     function WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer;
       AFlags: TsRelFlags): Word; override;
     function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
@@ -2754,25 +2756,79 @@ end;
 -------------------------------------------------------------------------------}
 procedure TsSpreadBIFF8Writer.WriteEXTERNSHEET(AStream: TStream);
 var
-  sheets: Array of Integer;
+  n, i: Integer;
+begin
+  { Since sheet range are not supported we simply note every sheet here. }
+  n := FWorkbook.GetWorksheetCount;
+
+  { BIFF record header }
+  WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNSHEET, 2 + 6*n);
+
+  { Count of following REF structures }
+  AStream.WriteWord(WordToLE(n));
+
+  { REF record for each sheet }
+  for i := 0 to n-1 do
+  begin
+    AStream.WriteWord(0);            // Index to EXTERNBOOK record, always 0
+    AStream.WriteWord(WordToLE(i));  // Index to first sheet in EXTERNBOOK sheet list
+    AStream.WriteWord(WordToLE(i));  // Index to last sheet in EXTERNBOOK sheet list
+  end;
+end;
+(*
+
+  write a record for
+  // every sheet
+type
+  TExternRefRec = record
+    FirstIndex, LastIndex: Word;
+  end;
+const
+  BUF_COUNT = 10;
+var
+  extern: Array of TExternRefRec;
   sheet: TsWorksheet;
-  i: Integer;
+  cell: PCell;
+  i, j: Integer;
   n: Word;
   writeIt: Boolean;
 begin
+
   n := 0;
-  SetLength(sheets, FWorkbook.GetWorksheetCount);
+  SetLength(extern, BUF_COUNT);
-  for i := 0 to FWorkbook.GetWorksheetCount-1 do begin
+
-    sheet := FWorkbook.GetWorksheetByIndex(i);
+  // Find sheets used in formula references
+  for i:=0 to FWorkBook.GetWorksheetCount-1 do begin
+    sheet := FWorkBook.GetWorksheetByIndex(i);
+    for cell in sheet.Cells do
+      if HasFormula(cell) then
+        if pos('!', cell^.FormulaValue) > 0 then
+          for j:=0 to FWorkbook.GetWorksheetCount-1 do
+            if pos(FWorksbook.GetWorksheetByIndex(j).Name, cell1.FormulaValue) = 1 then begin
+              extern[n].FirstIndex := j;
+              extern[n].LastIndex := j;
+              // NOTE: This must be extended to allow a range of sheets !!!
+              inc(n);
+              if n mod BUF_COUNT = 0 then
+                Setlength(extern, Length(extern) + BUF_COUNT);
+            end;
+  end;
+
+  // Find sheets used in print ranges, repeated cols or repeated rows
+  for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
+    sheet := FWorkbook.GetWorksheetbyIndex(i);
     with sheet.PageLayout do
       writeIt := (NumPrintRanges > 0) or HasRepeatedCols or HasRepeatedRows;
-    if writeIt then
+    if writeIt then begin
-    begin
+      extern[n].FirstIndex := i;
-      sheets[n] := i;
+      extern[n].LastIndex := i;
       inc(n);
+      if n mod BUF_COUNT = 0 then
+        SetLength(extern, Length(extern) + BUF_COUNT);
     end;
   end;
-  SetLength(sheets, n);
+
+  SetLength(extern, n);
 
   { BIFF record header }
   WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNSHEET, 2 + 6*n);
@@ -2784,10 +2840,10 @@ begin
   for i := 0 to n-1 do
   begin
     AStream.WriteWord(0);                    // Index to EXTERNBOOK record, always 0
-    AStream.WriteWord(WordToLE(sheets[i]));  // Index to first sheet in EXTERNBOOK sheet list
+    AStream.WriteWord(WordToLE(extern[i]));  // Index to first sheet in EXTERNBOOK sheet list
-    AStream.WriteWord(WordToLE(sheets[i]));  // Index to last sheet in EXTERNBOOK sheet list
+    AStream.WriteWord(WordToLE(extern[i]));  // Index to last sheet in EXTERNBOOK sheet list
   end;
-end;
+end;        *)
 
 {@@ ----------------------------------------------------------------------------
   Writes an Excel 8 FONT record.
@@ -3569,6 +3625,21 @@ begin
   Result := 4;
 end;
 
+function TsSpreadBIFF8Writer.WriteRPNCellAddress3D(AStream: TStream;
+  ASheet, ARow, ACol: Cardinal; AFlags: TsRelFlags): Word;
+var
+  c: Cardinal;
+begin
+  // Next line is a simplification: We should write the index of the sheet
+  // in the REF record here, but these are arranged in the same order as the
+  // sheets. --> MUST BE RE-DONE ONCE SHEET RANGES ARE ALLOWED.
+  AStream.WriteWord(WordToLE(ASheet));
+
+  // The row/col address is written in relative notation!
+  Result := 2 + WriteRPNCellAddress(AStream, ARow, ACol, [rfRelRow, rfRelCol]);
+end;
+
+
 {@@ ----------------------------------------------------------------------------
   Writes row and column offset needed in RPN formulas (unsigned integers!)
   Valid for BIFF2-BIFF5.

components/fpspreadsheet/source/common/xlscommon.pas

@@ -610,6 +610,8 @@ type
 
     function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
       AFlags: TsRelFlags): Word; virtual;
+    function WriteRPNCellAddress3D(AStream: TStream; ASheet, ARow, ACol: Cardinal;
+      AFlags: TsRelFlags): Word; virtual;
     function WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer;
       AFlags: TsRelFlags): Word; virtual;
     function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
@@ -675,8 +677,9 @@ const
     INT_EXCEL_TOKEN_TREFR,          {fekCellRef}
     INT_EXCEL_TOKEN_TAREA_R,        {fekCellRange}
     INT_EXCEL_TOKEN_TREFN_V,        {fekCellOffset}
-    INT_EXCEL_TOKEN_TREF3D_R,       {fekCellRef3d }
+    INT_EXCEL_TOKEN_TREF3D_V,       {fskCell3d}
-    INT_EXCEL_TOKEN_TAREA3D_R,      {fekCellRange3d }
+    INT_EXCEL_TOKEN_TREF3D_R,       {fekCellRef3d}
+    INT_EXCEL_TOKEN_TAREA3D_R,      {fekCellRange3d}
     INT_EXCEL_TOKEN_TNUM,           {fekNum}
     INT_EXCEL_TOKEN_TINT,           {fekInteger}
     INT_EXCEL_TOKEN_TSTR,           {fekString}
@@ -4291,6 +4294,17 @@ begin
   Result := 3;
 end;
 
+{@ -----------------------------------------------------------------------------
+  Writes the address of a cell as used in an RPN formula and returns the
+  count of bytes written.
+  Placeholder. To be overridden by BIFF5 and BIFF8.
+-------------------------------------------------------------------------------}
+function TsSpreadBIFFWriter.WriteRPNCellAddress3D(AStream: TStream;
+  ASheet, ARow, ACol: Cardinal; AFlags: TsRelFlags): Word;
+begin
+  Result := 0;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Writes row and column offset (unsigned integers!)
   Valid for BIFF2-BIFF5.
@@ -4570,6 +4584,17 @@ begin
           inc(RPNLength, n);
         end;
 
+      INT_EXCEL_TOKEN_TREF3D_V: { fekCell3D }
+        begin
+          n := WriteRPNCellAddress3D(
+            AStream,
+            AFormula[i].Sheet,
+            AFormula[i].Row, AFormula[i].Col,
+            AFormula[i].RelFlags
+          );
+          inc(RPNLength, n);
+        end;
+
       INT_EXCEL_TOKEN_TAREA_R: { fekCellRange }
         begin
           n := WriteRPNCellRangeAddress(