[Semi-Solved] Macro to Sendkeys

[the.white.hole]

Hi Guys,

This is rather unorthodox but im required to compile something that works, maybe if someone has another way could suggest


Im currently storing multiple rows of data within one cell using the Carriage Return (not clean i know) so the data ends up messy. Basically I need a macro that deletes off the last entry. For example if my cell of data consists of:

ABC 123
ASD223
ACAC2


I would like the end product to be:

ABC 123
ASD223

My plan is to get a macro to automate the SHIFT+UP key, then pressing the delete key.

[Charlie Young]

Hi Guys,

This is rather unorthodox but im required to compile something that works, maybe if someone has another way could suggest


Im currently storing multiple rows of data within one cell using the Carriage Return (not clean i know) so the data ends up messy. Basically I need a macro that deletes off the last entry. For example if my cell of data consists of:

ABC 123
ASD223
ACAC2


I would like the end product to be:

ABC 123
ASD223

My plan is to get a macro to automate the SHIFT+UP key, then pressing the delete key.

The line break character in a cell is ascii 10, and one could probably construct a cell formula to do the job. But here is a macro, which uses the sometimes handy string reverse function (also included), to operate on the current selection.

Code: Select all

sub deletelastline
	Dim oDoc As Object
	Dim oSelection As Object
	Dim s As String
	dim i As Long, j As Long
	Dim  c10 As Long
	
	oDoc = ThisComponent
	oSelection = oDoc.CurrentSelection
	if oSelection.supportsService("com.sun.star.sheet.SheetCellRange") then
		for i = 0 to oSelection.rows.count - 1
			for j = 0 to oSelection.columns.count - 1
				s = oSelection.getCellByPosition(j,i).String
				if Len(s) > 0 then
					s = reverse(s)
					c10 = InStr(s,Chr(10))
					if c10 > 0 then
						s = Right(s,Len(s) - c10)
						oSelection.getCellByPosition(j,i).setString(reverse(s))
					endif
				endif
			next j
		next i
	endif
					
end sub


Function reverse(r As String) As String
    Dim t As String
    Dim c As String
    Dim i, l As Integer
   
    t = r
    l = Len(t)
    i = 1
   
    Do While i < l
        c = Mid(t, i, 1)
        Mid(t, i, 1) = Mid(t, l, 1)
        Mid(t, l, 1) = c
        i = i + 1
        l = l - 1
    Loop
    reverse = t
End Function

[the.white.hole]

Hi Charlie,


**EDIT**: Works like a charm now. Thanks!



However, on the main point, does OO support something similar to a sendkeys function like VBA?

[MrProgrammer]

There's no need to write a macro. Select the cells, Edit > Find & Replace, More options, select Current selection only and Regular expressions, Search for ^((.|\x000A)*)\x000A.*$, Replace with $1, Replace All. I recommend unchecking Current selection only and Regular expressions, before clicking Close.

[the.white.hole]

Hi MrProgrammer,

Thanks for the suggestion. However, I need is to be a macro, because it will be assigned to a button to be made user-friendly for people to submit/remove inputs. Hence the idea you put above wont really fit in.

[Arineckaig]

However, on the main point, does OO support something similar to a sendkeys function like VBA?

Though I would expect there to be a better way, you could try for "something similar" at:
http://wiki.services.openoffice.org/wik ... c_commands

[Charlie Young]

Hi Charlie,

However, on the main point, does OO support something similar to a sendkeys function like VBA?

You can use SendKeys in Calc, or most any other application, using Windows scripting.

Make a script text file, say calcscript.wsf, containing

Code: Select all

<package>
   <job id="vbs">
      <script language="VBScript">
		Dim Args
		Dim AppString
		
		Set Args = WScript.Arguments
		AppString = Args(0)
        set WshShell = WScript.CreateObject("WScript.Shell")
        WshShell.AppActivate AppString
        WshShell.SendKeys "{F2}+{UP}{DEL}~"
       </script>
   </job>
</package>

Which does edit ({F2}) Shift + Up (+{UP)), delete, then enter, in the active cell.

The AppActivate line wants the Window titlebar info, such as

Code: Select all

File.ods - OpenOffice.org Calc

and that is just

Code: Select all

StarDeskTop.ActiveFrame.Title

There is much to this scripting business, including several ways to run the files, but I'll use WScript, which accepts command line parameters as WScript.Arguments as in the file above.

So to run it as a Calc macro

Code: Select all

Sub RunWScript
	Dim AppString As String
	AppString = StarDeskTop.ActiveFrame.Title
	shell("WScript ""C:\...path ...\calcscript.wsf""" & " " & AppString,False)
End Sub