Paste to a cell, avoiding screen jump

Creating a macro - Writing a Script - Using the API (OpenOffice Basic, Python, BeanShell, JavaScript)
Post Reply
king_026
Posts: 22
Joined: Wed Oct 15, 2008 8:42 pm

Paste to a cell, avoiding screen jump

Post by king_026 »

I recorded a macro that copies a large section and then pastes it to a place offscreen, the problem is that to record it I have to select a cell offscreen and this causes the screen to jump far to the left and then back when i run the macro. Its not a big problem but it would be nice if I could just paste to a specific cell without making it the active one to avoid this screen jump. Also I have one that copies the cells back and it has the same screen jumping problem. The macro for pasting is below

Code: Select all

sub paste
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")


Dim ip as Integer

mf = msgbox ( "Are you sure you want to undo the last update?", 4, "Undo Update")

select case mf

case 6



rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$BU$1:$CK$95"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "ToPoint"
args4(0).Value = "$A$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args4())

rem ----------------------------------------------------------------------
dim args5(5) as new com.sun.star.beans.PropertyValue
args5(0).Name = "Flags"
args5(0).Value = "SVDFNT"
args5(1).Name = "FormulaCommand"
args5(1).Value = 0
args5(2).Name = "SkipEmptyCells"
args5(2).Value = false
args5(3).Name = "Transpose"
args5(3).Value = false
args5(4).Name = "AsLink"
args5(4).Value = false
args5(5).Name = "MoveMode"
args5(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args5())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$M$2"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())


case 7

end select



end sub
OOo 2.2.X on Ms Windows XP
User avatar
squenson
Volunteer
Posts: 1885
Joined: Wed Jan 30, 2008 9:21 pm
Location: Lausanne, Switzerland

Re: Paste to a cell, avoiding screen jump

Post by squenson »

A few useful routines:

Code: Select all

Sub ScreenUpdatingOn
' This routine allows screen updating

   ThisComponent.UnlockControllers
   ThisComponent.removeActionLock

End Sub


Sub ScreenUpdatingOff
' This routine blocks screen updating and therefore allows faster macro execution

   ThisComponent.addActionLock
   ThisComponent.LockControllers

End Sub


Sub CopyRange()
' --------------------------------------------------------
' Copy a range from one sheet to another sheet

	Dim oDocument As Object
	Dim Spreadsheet As Object


	Set oDocument = ThisComponent
	Set Spreadsheet = oDocument.Sheets.getByIndex(0)
	xRay Spreadsheet
	
							' Source range address (UNO struct)
	Dim mRangeAddress_src as New com.sun.star.table.CellRangeAddress
	
							' Destination cell address (UNO struct)
	Dim mCellAddress_dest as New com.sun.star.table.CellAddress
	
							' Source range: 4th sheet, C3:D4
	With mRangeAddress_src
	.Sheet = 3
	.StartColumn = 2
	.StartRow = 2
	.EndColumn = 3
	.EndRow = 3
	End With

							' Destination Cell: G10
	With mCellAddress_dest
	.Sheet = 3
	.Column = 5
	.Row = 9
	End With
	
	thisComponent.getSheets.getByIndex(3).copyRange(mCellAddress_dest, mRangeAddress_src)
	
End Sub
LibreOffice 4.2.3.3. on Ubuntu 14.04
Post Reply