Macro to swap contents of two cells (including formatting)

[Dragonman654]

Hello. I need to swap the content of two cells. In this thread, the following code was suggested:

Sub swap_values()

	doc = ThisComponent
	sel = doc.CurrentSelection
	
	If sel(0).ImplementationName = "ScCellObj" Then
		c1 = sel(0)
		c2 = sel(1)
	Else
		If sel(0).Columns.Count = 2 Then
			c1 = sel(0).getCellByPosition(0,0)
			c2 = sel(0).getCellByPosition(1,0)
		Else
			c1 = sel(0).getCellByPosition(0,0)
			c2 = sel(0).getCellByPosition(0,1)		
		End If
	End If
	
	tmp = c1.String
	c1.String = c2.String
	c2.String = tmp

End Sub

The problem is this macro only swaps the text between the cells. Please how to modify it so that it swaps the style (background color, font color) each cell has as well?

[Lupp]

As in every case of swapping you need a place where you temporarily can save the relevant properties of the object first getting to be overwritten. Only this way you can overwrite the second object with these properties later.
In the code you posted the variable temp is used for the mentioned purpose, but it can only hold the string property.
An interim cell object is much more demanding since it can’t be created independent of a sheet, and properties you aren’rt even thinking of can be afflicted.
If you can assure that the cells don’t contain formulas (or CF) probably depending on their CellAddresses, and that all the sheets with their probably thrown events won’t cause inacceptable side-effects, it can be done using an otherwise empty interim sheet.
If you can’t give the mentioned assurances, or don’t understand their meaning, it might be wasted time to try a suggestion - and using a posted “solution” might be dangerous to your data and to the functionality of your existing sheets.

(The term “contents” does NOT include formatting.)

[KamilLanda]

You can use getTransferable. But there can be problem with the dependencies in the formulas etc.

Sub swap_values()

	doc = ThisComponent
	sel = doc.CurrentSelection
	
	If sel(0).ImplementationName = "ScCellObj" Then
		c1 = sel(0)
		c2 = sel(1)
	Else
		If sel(0).Columns.Count = 2 Then
			c1 = sel(0).getCellByPosition(0,0)
			c2 = sel(0).getCellByPosition(1,0)
		Else
			c1 = sel(0).getCellByPosition(0,0)
			c2 = sel(0).getCellByPosition(0,1)		
		End If
	End If
	
	dim data1 as object, data2 as object
	doc.CurrentController.Select(c1)
	data1=doc.CurrentController.getTransferable
	doc.CurrentController.Select(c2)
	data2=doc.CurrentController.getTransferable
	
	doc.CurrentController.Select(c1)
	doc.CurrentController.insertTransferable(data2)
	doc.CurrentController.Select(c2)
	doc.CurrentController.insertTransferable(data1)

End Sub

[Lupp]

Good idea to use saved transferable objects.

• However, I wouldn’t advise users to disable the overwrite warning.
  How would you handle it?
• Having created the first transferable object (for c1) , you can copy c2 over c1 using
  copyRange(c1.CellAddress, c2.RangeAddress) and omit one of tzhe insertions.
• The way to get c1, c2 as two selected ranges from the CurrentSelection won’t work for two adjacent cells.
• Implementation names aren’t assured to be long-term stable. Service names are.

I also tested my “funny idea” to use a temporary sheet. It compared to code based on your suggestion by about +20% in needed time (if overwrite warning was off; 100 repts).

If it can work at all, the code below seems to be the fastest variant to discuss here:

Sub swapTwoCellsLockStockBarrelUsingFreeHelperCell(pCell1, pCell2, pCellh)
srvcSheet = pCell1.Spreadsheet
REM The swap:
  srvcSheet.copyRange(pCellh.CellAddress, pCell1.RangeAddress)
  srvcSheet.copyRange(pCell1.CellAddress, pCell2.RangeAddress)
  srvcSheet.copyRange(pCell2.CellAddress, pCellh.RangeAddress)
REM Swap done.
End Sub

[Villeroy]

f1 = cell1.getFormula()
f2 = cell2.getFormula()
s1 = cell1.CellStyle
s2 = cell2.CellStyle
cell1.setFormula(f2)
cell2.setFormula(f1)
cell1.CellStyle = s2
cell2.CellStyle = s1

If people would use cell styles …