Copying MergedCells from 1 Sheet to another -> invalid?

[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

[larsa]

Hello

Don't use Assign. Use CopySheet (or CopyCells). This works with merged cells.

[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.

[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;

[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;
...