Calc - Copy merged cells when adding new rows

Hello Everyone,

Lets say you have a spreadsheet.

Rows 1-10 each have Columns A, B and C merged together.

Now say you want to add a new row between Row 4 and 5.

When you select Row 5 it highlights the Row 5 going from Column A, B and C.

Now when you use your trusty “Insert Rows Above” tool it creates a new row.

Problem is this new row no longer has Columns A, B and C merged together.

Does anyone know of any settings that could allow Calc to copy the merged properties of the cells selected when inserting new rows between them?

Thank You

Hi

May be a workaround: we can get the desired result by the Paste SpecialSelection: FormatsShift Cells:Down (must already have copied the line first of course)

Regards

The insert range and copy paste special can be automated using the following macro. This could be assigned to a hot key.

Select the range to insert, run InsertFormatRange, this will insert the range and copy paste formats and cell merge from the top row of your original selection.

REM  *****  BASIC  *****

Option Explicit

Sub InsertFormatRange
	
	Dim oCurSelection As Object
	
	oCurSelection = thisComponent.CurrentSelection
	
	oCurSelection.Spreadsheet.insertCells(oCurSelection.RangeAddress, com.sun.star.sheet.CellInsertMode.DOWN)
	
	FormatRange
End Sub

Sub FormatRange
'	Format selected Range to match the row above the selection '

	Dim oCurSelection As Object
	Dim oController As Object
	Dim oSelRangeAddress As New com.sun.star.table.CellRangeAddress
	Dim oRefRangeAddress As New com.sun.star.table.CellRangeAddress
	Dim sSelAbsoluteName As String
	Dim sRefAbsoluteName As String
	
	oCurSelection = thisComponent.CurrentSelection
	sSelAbsoluteName = oCurSelection.AbsoluteName
	oSelRangeAddress = oCurSelection.RangeAddress
	
	If oSelRangeAddress.StartRow < 1 Then
		msgbox	"There is no row above the selection to copy formats."
		Exit Sub
	End If
	
	oRefRangeAddress = oSelRangeAddress
	oRefRangeAddress.StartRow = oSelRangeAddress.StartRow - 1
	oRefRangeAddress.EndRow = oSelRangeAddress.StartRow - 1
	
	sRefAbsoluteName = CellAddressString(oRefRangeAddress)
	
	'	Now use dispatch to copy and paste special '
	
	rem ----------------------------------------------------------------------
	rem define variables
	dim document   as object
	dim dispatcher as object
	rem ----------------------------------------------------------------------
	rem get access to the document
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	rem ----------------------------------------------------------------------
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "ToPoint"
	args1(0).Value = sRefAbsoluteName
	
	dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
	
	rem ----------------------------------------------------------------------
	dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
	
	rem ----------------------------------------------------------------------
	dim args3(0) as new com.sun.star.beans.PropertyValue
	args3(0).Name = "ToPoint"
	args3(0).Value = sSelAbsoluteName
	
	dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
	
	rem ----------------------------------------------------------------------
	dim args4(5) as new com.sun.star.beans.PropertyValue
	args4(0).Name = "Flags"
	args4(0).Value = "T"
	args4(1).Name = "FormulaCommand"
	args4(1).Value = 0
	args4(2).Name = "SkipEmptyCells"
	args4(2).Value = false
	args4(3).Name = "Transpose"
	args4(3).Value = false
	args4(4).Name = "AsLink"
	args4(4).Value = false
	args4(5).Name = "MoveMode"
	args4(5).Value = 6
	
	dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())
End Sub

Function CellAddressString(oCellAddr as Object) as String
	
	Dim FuncService As Object

	'	Create service to access sheet functions '
	FuncService = createunoservice("com.sun.star.sheet.FunctionAccess")
	
	CellAddressString = FuncService.CallFunction("ADDRESS", _
											array(oCellAddr.StartRow+1, _
											oCellAddr.StartColumn+1))
	
	If oCellAddr.EndRow > oCellAddr.StartRow Or oCellAddr.EndColumn > oCellAddr.StartColumn Then
		CellAddressString = CellAddressString _
							& ":" & FuncService.CallFunction("ADDRESS", _
							array(oCellAddr.EndRow+1, oCellAddr.EndColumn+1))
	End If									
End Function

My edit is only to add ' at the end of comment line (no need in LibO Basic but here yes…)

Thanks, it does improve format, I’ll try to remember to include in future.