Page 1 of 1
Copying MergedCells from 1 Sheet to another -> invalid?
Posted: Tue Jan 06, 2015 12:47 pm
by MLG
Hello
I try to copy the contents of a sheet to a new sheet in the same workbook, but the merged cells are not copied, so I try to manually copy them.
The problem is, that when I open the resulting xlsx-file, Excel tells me that there is unreadable data in the file and if it should correct them. Once corrected, the file is OK, but I cannot produce a valid file this way.
This is the code I use to copy the merged cells:
Code: Select all
for i := 0 to AXls.Sheets[ASourceSheetNr].MergedCells.Count - 1 do
begin
oMergedCell := AXls.Sheets[ADestSheetNr].MergedCells.Add;
oMergedCell.Assign(AXls.Sheets[ASourceSheetNr].MergedCells.Items[i]);
end;
Is this a bug, do I forget something or are merged cells not supported anymore?
Greetings
MLG
Re: Copying MergedCells from 1 Sheet to another -> invalid?
Posted: Tue Jan 20, 2015 7:51 pm
by larsa
Hello
Don't use Assign. Use CopySheet (or CopyCells). This works with merged cells.
Re: Copying MergedCells from 1 Sheet to another -> invalid?
Posted: Fri Jan 23, 2015 2:54 pm
by MLG
I use CopySheet, the problem is that it doesn't copy the merged cells, that is why I wrote this function, whicht merges the cell on the copied sheet but gives me a warning on opening of the workbook.
Re: Copying MergedCells from 1 Sheet to another -> invalid?
Posted: Fri Jul 10, 2015 12:20 am
by mwhiting
MLG, This was my fix for copying sheets as merged cells aren't the only thing that doesn't copy. This gets everything I was concerned about. Hopefully this is helpful
Code: Select all
procedure SetSheetProperties(aSheetId: integer);
begin
//Freeze panes
XLS[aSheetId].FreezePanes(2,4);
//Set the groups to have the collapse/expand button on the row above the group
XLS[aSheetId].Xc12Sheet.SheetPr.OutlinePr.SummaryBelow := false;
end;
function GetSheetNameForNameDefn( aSheetId: integer): string;
begin
result := '''' + XLS[aSheetId].Name + '''!';
end;
procedure CopySheetThorough(aSrcSheetId,aDestSheetId : integer);
var
currName : TXLSName;
mergedCells : TXLSMergedCells;
srcNames : TStringList;
origDefnWOSheetName : string;
i : integer;
begin
XLS.CopySheet(aSrcSheetId,aDestSheetId);
srcNames := TStringList.Create;
XLS.Names.ToStrings(aSrcSheetId,srcNames);
//Copy items that CopySheet leaves out
//..Copy names and adjust for the new sheet
for i := 0 to srcNames.Count-1 do begin
//Skip the names that are of scope workbook
if XLS.Names.Find(srcNames[i]) <> nil then
Continue;
currName := XLS.Names.FindSheet(srcNames[i],aSrcSheetId);
origDefnWOSheetName := ReplaceSubStr(currName.Definition, GetSheetNameForNameDefn(aSrcSheetId),'');
XLS.Names.Add(srcNames[i],GetSheetNameForNameDefn(aDestSheetId) + origDefnWOSheetName, aDestSheetId);
end;
//..Copy mergecells
mergedCells := XLS[aSrcSheetId].MergedCells;
for i := 0 to mergedCells.Count-1 do begin
XLS[aDestSheetId].MergedCells.Add(mergedCells[i].Ref);
end;
//..Set things I needed that I couldn't figure out how to copy
SetRocSheetProperties(aDestSheetId);
end;
Need to add FindSheet to TXLSNames class in XLSNames5.pas because the Find only works for names that are defined with a scope of workbook.
Code: Select all
function FindSheet(const AName: AxUCString; aSheetId : integer): TXLSName;
function TXLSNames.FindSheet(const AName: AxUCString;
aSheetId : integer): TXLSName;
var
i: integer;
begin
i := FindId(AName,aSheetId);
if i >= 0 then
Result := Items[i]
else
Result := Nil;
end;
Re: Copying MergedCells from 1 Sheet to another -> invalid?
Posted: Fri Jul 10, 2015 1:51 pm
by mwhiting
I also needed comments:
Code: Select all
var
...
comments : TXLSComments;
begin
...
//..Copy comments
comments := XLS[aSrcSheetId].Comments;
for i := 0 to comments.Count-1 do begin
//TODO - Add size info when that is actually available. (Currently not 7/10/2015) - Matt W
XLS[aDestSheetId].Comments.Add(comments[i].Col,comments[i].Row,comments[i].PlainText);
end;
...