Ask Your Question
1

Macro on leaving a cell [closed]

asked 2018-07-01 22:53:58 +0100

BillC gravatar image

updated 2018-07-01 22:56:32 +0100

Ratslinger gravatar image

I am trying to change the Tab/Enter order of the cells in a few specific groups of a spreadsheet. The code below kinda works but only if the cell changes and you don't press arrow keys to leave. Is there a way to fix or replace this code to work even if the cell contents don't change and using Enter/Tab/Arrow keys (would still like to be able to use mouse to click elsewhere) And maybe I am an idiot, but I can't seem to get the code to properly format here after several attempts.

    Global oModifyListener
Global oCell

dim document   as object
dim dispatcher as object
dim args(1) as new com.sun.star.beans.PropertyValue

REM call this method once to set the ModifyListener.
REM to destroy the listener, call oCell.removeModifyListener( oModifyListener )
Sub SetModifyListener()
    oDoc = ThisComponent
    If NOT oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then Exit Sub
REM ( change "A1" to the cell which should trigger the callback if modified )
    Dim strCellAddress
    oModifyListener = createUnoListener("CellModify_","com.sun.star.util.XModifyListener")
    oSheet = ThisComponent.CurrentController.ActiveSheet
REM first range
    strCellAddress = "D1:D10"      REM Your Cell Address here.
    oCell = oSheet.getCellRangebyName( strCellAddress )
    oCell.addModifyListener( oModifyListener )
REM seond range    
    strCellAddress = "H1:H10"
    oCell = oSheet.getCellRangebyName( strCellAddress )
    oCell.addModifyListener( oModifyListener )
End Sub

Sub CellModify_modified( oEvent )
    Dim mycol : mycol = CurrentColumn()
    Dim myrow : myrow = CurrentRow()
    If mycol = 4 then
        If myrow = 10 then 
            goThere("E1")
        ElseIf myrow < 10 then
            goThere("A"+(myrow+1))
        EndIf
    Elseif mycol = 8 then
        If myrow = 10 then 
            goThere("A1")
        ElseIf myrow < 10 then
            goThere("E"+(myrow+1))
        EndIf
    EndIf       
End Sub

Sub CellModify_disposing( oEvent )
    REM not sure what this is for, just seems to spam on exit of spreadsheet
    REM Msgbox "Disposing"
End Sub

Function CurrentColumn() As Long
Dim ODoc As Object
Dim OSel As Object
oDoc = ThisComponent
oSel = oDoc.GetCurrentSelection()
If Not oSel.supportsService("com.sun.star.sheet.SheetCellRange") Then Exit Function
If (oSel.Columns().Count() > 1) Then Exit Function
CurrentColumn = oSel.CellAddress.Column()+1
End Function

Function CurrentRow() As Long
Dim ODoc As Object
Dim OSel As Object
oDoc = ThisComponent
oSel = oDoc.GetCurrentSelection()
If Not oSel.supportsService("com.sun.star.sheet.SheetCellRange") Then Exit Function
If (oSel.Rows().Count() > 1) Then Exit Function
CurrentRow = oSel.CellAddress.Row()+1
End Function


REM it would be nice if I could use coordinates instead of cell name
Sub gotoCell
   goThere("B4")
End Sub

Sub goThere(CellName As String)
   dim args(0) as new com.sun.star.beans.PropertyValue
   dim oDoc  as object
   dim dispatcher as object

   oDoc = ThisComponent.CurrentController.Frame
   args(0).Name = "ToPoint"
   args(0).Value = CellName
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
   dispatcher.executeDispatch(oDoc, ".uno:GoToCell", "", 0, args())

End Sub
edit retag flag offensive reopen merge delete

Closed for the following reason the question is answered, right answer was accepted by erAck
close date 2018-07-06 17:28:52.659051

Comments

@BillC To properly format, use the preformatted text icon on toolbar when entering/editing a question/answer or comment. Just select all the code then click the icon.

Ratslinger gravatar imageRatslinger ( 2018-07-01 22:59:56 +0100 )edit

If you want to format code manually: first, the Ask doesn't treat a single newline in usual text (it turns to simple space). To add a newline, you put two newlines.

Second, it treats a line with 4 leading spaces as a pre-formatted text. For pre-formatted text, it properly handles single newlines. So, to pre-format some block of lines, you paste them to the answer, and prepend each line with 4 additional spaces (so that their indentation is kept). Or do that in an IDE in advance.

Mike Kaganski gravatar imageMike Kaganski ( 2018-07-02 02:54:07 +0100 )edit

@Ratslinger Thanks for fixing it, I pressed the button and it said enter code here so I pasted it, seems I have to try that in the opposite order then (paste, highlight, press button). @Mike Kaganski Thanks for the info, will try that next time also.

BillC gravatar imageBillC ( 2018-07-02 05:47:30 +0100 )edit

1 Answer

Sort by » oldest newest most voted
1

answered 2018-07-02 23:17:56 +0100

Jim K gravatar image

updated 2018-07-02 23:47:55 +0100

Here is the complete working code. Right-click on the sheet tab and assign it to the Selection changed sheet event.

Global prevsheet As Integer
Global prevcol As Integer
Global prevrow As Integer

Sub selectionChanged(oEvent)
    oSel = ThisComponent.CurrentSelection
    If Not oSel.SupportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub
    If prevsheet = oSel.RangeAddress.Sheet _
            And prevcol = oSel.RangeAddress.StartColumn _
            And prevrow = oSel.RangeAddress.StartRow Then
        'No change.'
        Exit Sub
    End If
    newcol = -1
    newrow = -1
    If prevsheet = 0 Then
        If prevcol = 3 Then
            If prevrow = 9 Then
                newcol = 4
                newrow = 0
            ElseIf prevrow < 9 Then
                newcol = 0
                newrow = prevrow + 1
            End If
        ElseIf prevcol = 7 Then
            If prevrow = 9 Then 
                newcol = 0
                newrow = 0
            ElseIf prevrow < 9 Then
                newcol = 4
                newrow = prevrow + 1
            End If
        End If
    End If
    If newcol > -1 And newrow > -1 Then
        oSheet = ThisComponent.getSheets().getByIndex(0)
        oCell = oSheet.getCellByPosition(newcol, newrow)
        prevsheet = 0
        prevcol = newcol
        prevrow = newrow
        ThisComponent.getCurrentController().select(oCell)
    Else
        oSel = ThisComponent.CurrentSelection
        If Not oSel.SupportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub
        prevsheet = oSel.RangeAddress.Sheet
        prevcol = oSel.RangeAddress.StartColumn
        prevrow = oSel.RangeAddress.StartRow
    End If
End Sub

Now, start in cell A1 and press a (for example) plus the right arrow key, then keep repeating. This cycles through all of the cells.

Note that the column and row numbers are 0-based, so column E is column number 4.

References:

edit flag offensive delete link more

Comments

1

Thanks! That looks much better, but I was having a problem if I used the ENTER key, it would get stuck on the jumped to cell. I added 2 lines of code that solved that problem. After "ThisComponent.getCurrentController().select(oCell)" I added "oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")" and "ThisComponent.getCurrentController().Select(oRanges)"

BillC gravatar imageBillC ( 2018-07-03 21:18:45 +0100 )edit

That sounds like a good fix. Glad you were able to figure it out.

Jim K gravatar imageJim K ( 2018-07-04 00:22:41 +0100 )edit

Question Tools

1 follower

Stats

Asked: 2018-07-01 22:53:58 +0100

Seen: 55 times

Last updated: Jul 02 '18