Calc - Copy merged cells when adding new rows

[miketurn]

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

[PYS]

Hi

May be a workaround: we can get the desired result by the Paste Special▸Selection: Formats▸Shift Cells:Down (must already have copied the line first of course)

Regards

[mark_t]

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

[PYS]

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

[mark_t]

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