paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Adjust defined name ranges when rows/cols are inserted/deleted. Handle #REF! error in defined names.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9409 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-07-31 18:30:29 +00:00
parent 6a319f55b8
commit 12ee2c0b1b
8 changed files with 218 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas
View File

@ -116,7 +116,7 @@ begin
sh.WriteText(row, 1, 'background gray');
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcLessEqual, 5, fmtIdx);
// conditional format #6: between
// conditional format #7: between
inc(row);
sh.WriteText(row, 0, 'between 2 and 7');
sh.WriteText(row, 1, 'background light gray');
@ -124,13 +124,13 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcBetween, 2, 7, fmtIdx);
// conditional format #6: not between
// conditional format #8: not between
inc(row);
sh.WriteText(row, 0, 'not between 2 and 7');
sh.WriteText(row, 1, 'background light gray');
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcNotBetween, 2, 7, fmtIdx);
// conditional format #6: above average
// conditional format #9: above average
inc(row);
sh.WriteText(row, 0, '> average');
sh.WriteText(row, 1, 'hatched background yellow on red');
@ -139,7 +139,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, 10), cfcAboveAverage, fmtIdx); // only 1..9 -> ave = 5
// conditional format #6: below average
// conditional format #10: below average
inc(row);
sh.WriteText(row, 0, '< average');
sh.WriteText(row, 1, 'dotted background yellow on red');
@ -148,7 +148,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, 10), cfcBelowAverage, fmtIdx); // only 1..9 -> ave = 5
// conditional format #6: above or equal to average
// conditional format #11: above or equal to average
inc(row);
sh.WriteText(row, 0, '>= average');
sh.WriteText(row, 1, 'hor striped background yellow on red');
@ -157,7 +157,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, 10), cfcAboveEqualAverage, fmtIdx); // only 1..9 -> ave = 5
// conditional format #6: below or equal to average
// conditional format #12: below or equal to average
inc(row);
sh.WriteText(row, 0, '<= average');
sh.WriteText(row, 1, 'vert striped background yellow on red');
@ -166,7 +166,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, 10), cfcBelowEqualAverage, fmtIdx); // only 1..9 -> ave = 5
// conditional format #6: top 3 values
// conditional format #13: top 3 values
inc(row);
sh.WriteText(row, 0, 'top 3 values');
sh.WriteText(row, 1, 'background green');
@ -174,7 +174,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcTop, 3, fmtIdx);
// conditional format #6: smallest 3 values
// conditional format #14: smallest 3 values
inc(row);
sh.WriteText(row, 0, 'smallest 3 values');
sh.WriteText(row, 1, 'background bright blue');
@ -182,7 +182,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcBottom, 3, fmtIdx);
// conditional format #6: top 30 percent
// conditional format #15: top 10 percent
inc(row);
sh.WriteText(row, 0, 'top 10 percent');
sh.WriteText(row, 1, 'background green');
@ -190,7 +190,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcTopPercent, 10, fmtIdx);
// conditional format #6: smallest 3 values
// conditional format #16: smallest 10 percent
inc(row);
sh.WriteText(row, 0, 'smallest 10 percent');
sh.WriteText(row, 1, 'background bright blue');
@ -198,7 +198,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcBottomPercent, 10, fmtIdx);
// conditional format #6: duplicates
// conditional format #17: duplicates
inc(row);
sh.WriteText(row, 0, 'duplicate values');
sh.WriteText(row, 1, 'background bright red');
@ -206,7 +206,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcDuplicate, fmtIdx);
// conditional format #6: unique
// conditional format #18: unique
inc(row);
sh.WriteText(row, 0, 'unique values');
sh.WriteText(row, 1, 'borders all sides');
@ -215,7 +215,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcUnique, fmtIdx);
// conditional format #6: contains any text
// conditional format #19: contains any text
inc(row);
sh.WriteText(row, 0, 'contains any text');
sh.WriteText(row, 1, 'background red');
@ -224,7 +224,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcContainsText, '', fmtIdx);
// conditional format #6: empty
// conditional format #20: empty
inc(row);
sh.WriteText(row, 0, 'empty');
sh.WriteText(row, 1, 'background red');
@ -232,7 +232,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcNotContainsText, '', fmtIdx);
// conditional format #6: text begins with 'ab'
// conditional format #21: text begins with 'ab'
inc(row);
sh.WriteText(row, 0, 'text begins with "ab"');
sh.WriteText(row, 1, 'background red');
@ -240,7 +240,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcBeginsWith, 'ab', fmtIdx);
// conditional format #6: text ends with 'g'
// conditional format #22: text ends with 'g'
inc(row);
sh.WriteText(row, 0, 'text ends with "g"');
sh.WriteText(row, 1, 'background red');
@ -248,7 +248,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcEndsWith, 'g', fmtIdx);
// conditional format #6: text contains 'ef'
// conditional format #23: text contains 'ef'
inc(row);
sh.WriteText(row, 0, 'text contains "ef"');
sh.WriteText(row, 1, 'background red');
@ -256,7 +256,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcContainsText, 'ef', fmtIdx);
// conditional format #6: text does NOT contain 'ef'
// conditional format #24: text does NOT contain 'ef'
inc(row);
sh.WriteText(row, 0, 'text does not contain "ef"');
sh.WriteText(row, 1, 'background red');
@ -264,7 +264,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcNotContainsText, 'ef', fmtIdx);
// conditional format #6: contains error
// conditional format #25: contains error
inc(row);
sh.WriteText(row, 0, 'contains error');
sh.WriteText(row, 1, 'background red');
@ -272,7 +272,7 @@ begin
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcContainsErrors, fmtIdx);
// conditional format #6: no errors
// conditional format #26: no errors
inc(row);
sh.WriteText(row, 0, 'no errors');
sh.WriteText(row, 1, 'background yellow, font "Courier New"/red/bold/14');

20
components/fpspreadsheet/examples/other/defined_names/demo_read_definednames.lpr
View File

@ -1,7 +1,7 @@
program demo_read_definednames;
{$DEFINE ODS}
uses
fpspreadsheet, fpsTypes, fpsClasses, fpsUtils, fpsAllFormats;
SysUtils, fpspreadsheet, fpsTypes, fpsClasses, fpsUtils, fpsAllFormats;
var
wb: TsWorkbook;
ws: TsWorksheet;
@ -15,7 +15,7 @@ begin
fn := 'test_defnames.xlsx';
{$ENDIF}
//fn := 'test3D.xlsx';
fn := 'Mappe2.ods';
wb := TsWorkbook.Create;
try
@ -26,7 +26,13 @@ begin
WriteLn('DEFINED NAMES (GLOBAL)');
for i := 0 to wb.DefinedNames.Count-1 do
WriteLn(' "', wb.DefinedNames[i].Name, '" --> ', wb.DefinedNames[i].RangeAsString(wb));
begin
Write(' "', wb.DefinedNames[i].Name, '" --> ');
case ExtractFileExt(fn) of
'.xlsx': WriteLn(wb.DefinedNames[i].RangeAsString(wb));
'.ods': WriteLn(wb.DefinedNames[i].RangeAsString_ODS(wb));
end;
end;
WriteLn('--------------------------------------------------------');
@ -40,7 +46,13 @@ begin
WriteLn(' (none)')
else
for j := 0 to ws.DefinedNames.Count-1 do
WriteLn(' "', ws.DefinedNames[i].Name, '" --> ', ws.DefinedNames[i].RangeAsString(wb));
begin
Write(' "', ws.DefinedNames[i].Name, '" --> ');
case ExtractFileExt(fn) of
'.xlsx': WriteLn(ws.DefinedNames[i].RangeAsString(wb));
'.ods': WriteLn(ws.DefinedNames[i].RangeAsString_ODS(wb));
end;
end;
WriteLn(' CELLS');
for cell in ws.Cells do

106
components/fpspreadsheet/source/common/fpsclasses.pas
View File

@ -229,8 +229,10 @@ type
FRange: TsCellRange3D;
public
procedure CopyFrom(AItem: TsDefinedName);
function IllegalRef: Boolean;
function RangeAsString(AWorkbook: TsBasicWorkbook): String;
function RangeAsString_ODS(AWorkbook: TsBasicWorkbook): String;
procedure SetIllegalRef;
class function ValidName(AName: String): Boolean;
property Name: String read FName;
property Range: TsCellRange3D read FRange write FRange;
@ -244,8 +246,10 @@ type
public
function Add(AName: String; ASheetIndex: Integer; ARow, ACol: Cardinal): Integer; overload;
function Add(AName: String; ASheetIndex1, ASheetIndex2: Integer; ARow1, ACol1, ARow2, ACol2: Cardinal): Integer; overload;
procedure DeleteRowOrCol(AWorksheetIndex, AColRowIndex: Integer; IsRow: Boolean);
function DuplicateName(AName: String): Boolean;
function FindIndexOfName(AName: String): Integer;
procedure InsertRowOrCol(AWorksheetIndex, AColRowIndex: Integer; IsRow: Boolean);
property Items[AIndex: Integer]: TsDefinedName read GetItem write SetItem; default;
end;
@ -1847,6 +1851,11 @@ begin
end;
end;
function TsDefinedName.IllegalRef: Boolean;
begin
Result := (FRange.Row1 = UNASSIGNED_ROW_COL_INDEX);
end;
// Test!$C$3
function TsDefinedName.RangeAsString(AWorkbook: TsBasicWorkbook): String;
var
@ -1858,7 +1867,10 @@ begin
begin
sh1 := book.GetWorksheetByIndex(Sheet1);
sh2 := book.GetWorksheetByIndex(Sheet2);
Result := GetCellRangeString(sh1.Name, sh2.Name, Row1, Col1, Row2, Col2, [], true);
if IllegalRef then
Result := Format('%s!%s', [sh1.Name, STR_ERR_ILLEGAL_REF])
else
Result := GetCellRangeString(sh1.Name, sh2.Name, Row1, Col1, Row2, Col2, [], true);
end;
end;
@ -1872,6 +1884,11 @@ begin
with FRange do
begin
sh1 := book.GetWorksheetByIndex(Sheet1);
if IllegalRef then
begin
Result := Format('$%s!%s', [sh1.Name, STR_ERR_ILLEGAL_REF]); // Is '!' correct?
exit;
end;
Result := Format('$%s.%s', [sh1.Name, GetCellString(Row1, Col1, [])]);
if (Sheet1 <> Sheet2) or (Row1 <> Row2) or (Col1 <> Col2) then
begin
@ -1881,6 +1898,11 @@ begin
end;
end;
procedure TsDefinedName.SetIllegalRef;
begin
FRange.Row1 := UNASSIGNED_ROW_COL_INDEX;
end;
// https://www.ablebits.com/office-addins-blog/excel-named-range/
class function TsDefinedName.ValidName(AName: string): Boolean;
const
@ -1953,6 +1975,51 @@ begin
end;
end;
{ Adjusts the range extent when a row or column is deleted from the worksheet
with the given index. Note: Switches the defines names to #REF! when the
range is not valid after the deletion. }
procedure TsDefinedNames.DeleteRowOrCol(AWorksheetIndex, AColRowIndex: Integer;
IsRow: Boolean);
var
i: Integer;
item: TsDefinedName;
begin
for i := 0 to Count-1 do
begin
item := Items[i];
if (item.Range.Sheet1 <= AWorksheetIndex) and (AWorksheetIndex <= item.Range.Sheet2) then
begin
if IsRow then
begin
if (item.Range.Row1 = AColRowIndex) and (item.Range.Row2 = AColRowIndex) then
// Deleting the only row of the defined name's range --> #REF!
item.SetIllegalRef
else
if item.Range.Row1 <= AColRowIndex then
begin
dec(item.FRange.Row1);
dec(item.FRange.Row2);
end else
if AColRowIndex <= item.Range.Row2 then
dec(item.FRange.Row2);
end else
begin
if (item.Range.Col1 = AColRowIndex) and (item.Range.Col2 = AColRowIndex) then
// Deleting the only column of the defined name's range --> #REF!
item.SetIllegalRef
else
if item.Range.Col1 <= AColRowIndex then
begin
dec(item.FRange.Col1);
dec(item.FRange.Col2);
end else
if AColRowIndex <= item.Range.Col2 then
dec(item.FRange.Col2);
end;
end;
end;
end;
function TsDefinedNames.DuplicateName(AName: String): Boolean;
begin
Result := FindIndexOfName(AName) <> -1;
@ -1971,6 +2038,43 @@ begin
Result := TsDefinedName(inherited Items[AIndex]);
end;
{ AWorksheetIndex: Index of the worksheet in which a row/column is inserted
AColRowIndex: Index of the row or column to be inserted
IsRow: Indicator whether AColRow refers to a row or column }
procedure TsDefinedNames.InsertRowOrCol(AWorksheetIndex, AColRowIndex: Integer;
IsRow: Boolean);
var
i: Integer;
item: TsDefinedName;
begin
for i := 0 to Count-1 do
begin
item := Items[i];
if (item.Range.Sheet1 <= AWorksheetIndex) and (AWorksheetIndex <= item.Range.Sheet2) then
begin
if IsRow then
begin
if item.Range.Row1 <= AColRowIndex then
begin
inc(item.FRange.Row1);
inc(item.FRange.Row2);
end else
if AColRowIndex <= item.Range.Row2 then
inc(item.FRange.Row2);
end else
begin
if item.Range.Col1 <= AColRowIndex then
begin
inc(item.FRange.Col1);
inc(item.FRange.Col2);
end else
if AColRowIndex <= item.Range.Col2 then
inc(item.FRange.Col2);
end;
end;
end;
end;
procedure TsDefinedNames.SetItem(AIndex: Integer; AValue: TsDefinedName);
begin
TsDefinedName(inherited Items[AIndex]).CopyFrom(AValue);

8
components/fpspreadsheet/source/common/fpsexprparser.pas
View File

@ -2428,8 +2428,6 @@ var
begin
sheet := TsWorksheet(FWorksheet);
// FIXME: This code does not distinguish between local and global scope!
for i := 0 to sheet.Definednames.Count-1 do
begin
defName := sheet.DefinedNames[i];
@ -4031,6 +4029,12 @@ begin
c2 := Col2;
end;
if r1 = UNASSIGNED_ROW_COL_INDEX then
begin
AResult := ErrorResult(errIllegalRef);
exit;
end;
sheet := book.GetWorksheetByIndex(sheetIdx1);
if (sheetIdx1 = sheetIdx2) and IsSingleCell(sheet, r1, c1, r2, c2) then
begin

19
components/fpspreadsheet/source/common/fpsopendocument.pas
View File

@ -2642,10 +2642,13 @@ var
nodeName: String;
defName: String;
defAddr: String;
defExpr: String;
r1, c1, r2, c2: Cardinal;
sheetName1, sheetName2: String;
sheetIdx1, sheetIdx2: Integer;
flags: TsRelFlags;
err: TsErrorValue;
isDefName: Boolean;
begin
if ANode = nil then
exit;
@ -2660,11 +2663,25 @@ begin
while ANode <> nil do
begin
nodeName := ANode.NodeName;
if nodeName = 'table:named-range' then
if nodeName = 'table:named-expression' then
begin
defName := GetAttrValue(ANode, 'table:name');
defAddr := GetAttrValue(ANode, 'table:cell-range-address');
defExpr := GetAttrValue(ANode, 'table:expression');
if TryStrToErrorValue(defExpr, '!', sheetName1, err) then // not clear whether '!' is correct; test file was created from Excel
begin
r1 := UNASSIGNED_ROW_COL_INDEX;
c1 := UNASSIGNED_ROW_COL_INDEX;
r2 := UNASSIGNED_ROW_COL_INDEX;
c2 := UNASSIGNED_ROW_COL_INDEX;
sheetName2 := sheetName1;
isDefName := true;
end else
if TryStrToCellRange_ODS(defAddr, sheetName1, sheetName2, r1, c1, r2, c2, flags) then
isDefName := true
else
isDefName := false;
if isDefName then
begin
if (sheetName1 <> '') and (sheetName1[1] = '$') then Delete(sheetName1, 1,1);
if (sheetName2 <> '') and (sheetName2[1] = '$') then Delete(sheetName2, 1,1);

20
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -2208,7 +2208,7 @@ begin
if HasFormula(ACell) then
WriteFormula(ACell, '');
// To do: Check if the cell is referencec by a formula. In this case we have
// To do: Check if the cell is referenced by a formula. In this case we have
// a #REF! error.
// Cell is part of a merged block? --> Erase content, formatting etc.
@ -5821,6 +5821,15 @@ begin
// Fix conditional formats
FWorkbook.FConditionalFormatList.DeleteRowOrCol(Self, AIndex, IsRow);
// Fix defined names
i := FWorkbook.GetWorksheetIndex(Self);
FWorkbook.DefinedNames.DeleteRowOrCol(i, AIndex, IsRow);
for i := 0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetByIndex(i);
sheet.DefinedNames.DeleteRowOrCol(i, AIndex, IsRow);
end;
// Fix formulas:
// 1) Fix Row/Col index of in-sheet formulas
FFormulas.DeleteRowOrCol(AIndex, IsRow);
@ -5923,6 +5932,15 @@ begin
// Update range of conditional formats
FWorkbook.FConditionalFormatList.InsertRowOrCol(Self, AIndex, IsRow);
// Fix defined names
i := FWorkbook.GetWorksheetIndex(self);
FWorkbook.DefinedNames.InsertRowOrCol(i, AIndex, IsRow);
for i := 0 to FWorkbook.GetWorksheetCount-1 do
begin
sheet := FWorkbook.GetWorksheetByIndex(i);
sheet.DefinedNames.InsertRowOrCol(i, AIndex, IsRow);
end;
// Fix formulas:
// 1) Update Row/Col index of in-sheet formulas
FFormulas.InsertRowOrCol(AIndex, IsRow);

19
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -145,6 +145,8 @@ function GetSheetCellRangeString_ODS(ASheet1, ASheet2: String;
function GetErrorValueStr(AErrorValue: TsErrorValue): String;
function TryStrToErrorValue(AErrorStr: String; out AErr: TsErrorValue): boolean;
function TryStrToErrorValue(AErrorStr: String; SheetSep: Char;
out ASheetName: String; out AErr: TsErrorValue): Boolean;
function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; deprecated;
//function GetFileFormatExt(AFormat: TsSpreadsheetFormat): String;
@ -1506,7 +1508,7 @@ end;
function TryStrToErrorValue(AErrorStr: String; out AErr: TsErrorValue): boolean;
begin
Result := true;
case AErrorStr of
case Uppercase(AErrorStr) of
STR_ERR_EMPTY_INTERSECTION : AErr := errEmptyIntersection; // #NULL!
STR_ERR_DIVIDE_BY_ZERO : AErr := errDivideByZero; // #DIV/0!
STR_ERR_WRONG_TYPE : AErr := errWrongType; // #VALUE!
@ -1520,6 +1522,21 @@ begin
end;
end;
function TryStrToErrorValue(AErrorStr: String; SheetSep: Char;
out ASheetName: String; out AErr: TsErrorValue): Boolean;
var
p: Integer;
begin
p := pos(SheetSep, AErrorStr);
if p > 0 then
begin
ASheetName := Copy(AErrorStr, 1, p-1);
AErrorStr := Copy(AErrorStr, p+1, Length(AErrorStr));
end else
ASheetName := '';
Result := TryStrToErrorValue(AErrorStr, AErr);
end;
{@@ ----------------------------------------------------------------------------
Returns the message text assigned to an error value

16
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -2377,6 +2377,8 @@ var
namestr: String;
s, sheetname1, sheetName2: String;
sheetIdx1, sheetIdx2: Integer;
isDefinedName: Boolean;
err: TsErrorValue;
L: TStringList;
begin
if ANode = nil then
@ -2468,12 +2470,26 @@ begin
end;
// "Normal" defined names
isDefinedName := false;
s := GetNodeValue(node);
if TryStrToErrorValue(s, '!', sheetName1, err) then
begin
r1 := UNASSIGNED_ROW_COL_INDEX;
r2 := UNASSIGNED_ROW_COL_INDEX;
c1 := UNASSIGNED_ROW_COL_INDEX;
c2 := UNASSIGNED_ROW_COL_INDEX;
sheetName2 := sheetName1;
isDefinedName := true;
end else
if ParseCellRangeString(s, sheetName1, sheetName2, r1, c1, r2, c2, flags) then
begin
if (r2 = UNASSIGNED_ROW_COL_INDEX) then r2 := r1;
if (c2 = UNASSIGNED_ROW_COL_INDEX) then c2 := c1;
if sheetName2 = '' then sheetName2 := sheetName1;
isDefinedName := true;
end;
if isDefinedName then
begin
sheetIdx1 := book.GetWorksheetIndex(sheetName1);
sheetIdx2 := book.GetWorksheetIndex(sheetName2);
s := GetAttrValue(node, 'localSheetId');