In short:
To find out, one can't use the msgbox because it interrupts the event. So use the statusbar. There is a nice one in my code.
If more then 1 event-triggering is used, then it's sometimes unpredictable which one will fire first and how much programcode of the first event-sub has been exucuted before the other starts! Most listeners get lost on all sorts of actions and hard to know when they are lost! And finally one get frequently in a loop or error's because closing the error again triggers the sub with the errors. So save before running! This way you can kickout oo from the taskmanager with alt-ctrl-del
All I wanted to make is having some control on the data being changed, for securrity reasons, protect accidental overwriting data and change entered data before changing the active cell. Having a objPreviousCell, objPreviousCell-Value and objPreviousSelection. After 5 full days I almost give up, wanted to return to Excel, because it is very simple there. If they ever can add a event like "Changed Document" and "Changed Selection" to the oo-calc/tools/customize/events then it would be as simple as in Excel.
Here is the code, have fun and let us know what you found out...
Code: Select all
global oXKeyHandler as object
global oXMouseClickHandler as object
global bMouseButton as boolean
global bMouseDoubleClick as boolean
global oXModifyListener as object
global oXChartDataChangeEventListener as object
global oXSelectionChangeListener as object
global oXEventListener as object
global bListenerPaused as boolean
global bXSelectionChangeListener as boolean 'XSelectionChangeListener running
global oCurSel as object 'Range of CurrentSelection
global oCurCell as object 'CurrentCell = ActiveCell
global vCurVal as string 'CurrentValue of CurrentCell
global oPreSel as object 'Range of PreviousSelection
global oPreCell as object 'PreviousCell
global vPreVal as string 'PreviousValue of PreviousCell
global vNewVal as string 'NewValue of PreviousCell
global vPreLastRow as integer 'PreviousLastRow of usedrange before last change
global vPreLastCol as integer 'PreviousLastColumn of usedrange before last change
global vStatusBarText as string 'Text that is been displayed on the statusbar
sub main()
end sub
sub sInitialize
bListenerPaused=false
oCurSel=ThisComponent.CurrentSelection : oCurCell=o() : vCurVal=oCurCell.String
oPreSel=oCurSel : oPreCell=oCurCell : vPreVal=vCurVal
vPreLastRow=fLastRow : vPreLastCol=fLastCo
' sStatusBar
end sub
sub sEvent_ActivateDocument 'set to call in oo-Calc/Tools/Customize/Events/"Activate Document"
sInitialize 'Initialize variables after programming
sStartEventTrapper
end sub
sub sEvent_DeactivateDocument 'set to call in oo-Calc/Tools/Customize/Events/"Deactivate Document"
sStopEventTrapper
end sub
sub sEvent_OpenDocument 'set to call in oo-Calc/Tools/Customize/Events/"Open Document"
sStartMainListener 'only one time to initialize event-listeners
end sub
sub sEvent_CloseDocument 'set to call in oo-Calc/Tools/Customize/Events/"Close Document"
' sStopMainListener 'No use when programming loses the objects from the listeners.
end sub
' ---------------------------------- LISTENERS & HANDLERS --------------------------------------
sub sStartEventTrapper
if isNull(oXKeyHandler) then
oXKeyHandler = CreateUnoListener("XKeyHandler_", "com.sun.star.awt.XKeyHandler")
ThisComponent.GetCurrentController.AddKeyHandler(oXKeyHandler)
endif
if isNull(oXMouseClickHandler) then
oXMouseClickHandler = CreateUnoListener("XMouseClickHandler_", "com.sun.star.awt.XMouseClickHandler")
ThisComponent.CurrentController.AddMouseClickHandler(oXMouseClickHandler)
endif
if isNull(oXSelectionChangeListener) then
oXSelectionChangeListener=CreateUnoListener("XSelectionChangeListener_", "com.sun.star.view.XSelectionChangeListener")
'msgbox "If comming from print-preview, ERROR COMMING UP !!!"
ThisComponent.CurrentController.AddSelectionChangeListener(oXSelectionChangeListener)
sStatusBar
endif
sStatusBar ,"+"
end sub
sub sStopEventTrapper 'Need to stop these before the objects get lost while programming
if not IsNull(oXMouseClickHandler) then ThisComponent.CurrentController.removeMouseClickHandler(oXMouseClickHandler) : oXMouseClickHandler=nothing
if not IsNull(oXKeyHandler) then ThisComponent.GetCurrentController.removeKeyHandler(oXKeyHandler) : oXKeyHandler=nothing
if not isNull(oXSelectionChangeListener) then ThisComponent.CurrentController.removeSelectionChangeListener(oXSelectionChangeListener) : oXSelectionChangeListener=nothing
sStatusBar ,"-"
end sub
sub sStartMainListener 'start event intercepting
'!!! Most listeners get lost on all sorts of actions!!!
' oXModifyListener=CreateUnoListener("XModifyListener_", "com.sun.star.util.XModifyListener")
' ThisComponent.Sheets.GetByIndex(0).AddModifyListener(oXModifyListener)
'!!! BAD: Isn't usefull, because the changed range isn't been selected jet nor is it in the oEvent !!!
'!!! BUGG: ..._disposing doesn't get called. So one can't know when listener is suddenly gone !!!
' oXSelectionChangeListener=CreateUnoListener("XSelectionChangeListener_", "com.sun.star.view.XSelectionChangeListener")
' ThisComponent.CurrentController.AddSelectionChangeListener(oXSelectionChangeListener)
'!!! BAD: Stops sometimes like after a print-preview !!!
'!!! BAD: If used with an other listener it is not predictable which one will fire first and how much of the first sub has been exucuted before the other starts!!!
'!!! BUGG: ..._disposing doesn't get called. So one can't know when listener is suddenly gone !!!
'!!! Triggers even when mousebutton is still down, so it keeps on selecting while still running sub, like when Msgbox is up !!!
'!!! Following line can't be deleted, because otherwise the listener will stop if one inserts a line after the listener starts up !!!!
CreateUnoService("com.sun.star.frame.DispatchHelper").ExecuteDispatch(ThisComponent.CurrentController.Frame, ".uno:InsertRows", "", 0, Array())
oXChartDataChangeEventListener=CreateUnoListener("XChartDataChangeEventListener_", "com.sun.star.chart.XChartDataChangeEventListener")
ThisComponent.Sheets.GetByIndex(0).AddChartDataChangeEventListener(oXChartDataChangeEventListener) 'Triggers after changing selection but sometimes just stops working !!!
'!!! Following line is to delete the needed inserted empty line. This will also trigger the first listener !
CreateUnoService("com.sun.star.frame.DispatchHelper").ExecuteDispatch(ThisComponent.CurrentController.Frame, ".uno:DeleteRows", "", 0, Array())
oXEventListener=CreateUnoListener("XEventListener_", "com.sun.star.document.XEventListener")
ThisComponent.com_sun_star_document_XEventBroadcaster_addEventListener(oXEventListener)
'!!! Main listener, doesn't tell you when any data has changed, but it keeps running as far as I know...
'!!! Could be used to check if the other listeners are still working or stop/start them on some actions.
end sub
sub sStopMainListener
'!!! BUG: Only works when there is no programming done. Objects get lost but Listeners keeps running.
' If not IsNull(oXModifyListener) then ThisComponent.Sheets.GetByIndex(0).removemodifyListener(oXModifyListener) '=XModifyListener
' If not IsNull(oXSelectionChangeListener) then ThisComponent.CurrentController.removeSelectionChangeListener(oXSelectionChangeListener) '=XSelectionChangeListener
' If not IsNull(oXChartDataChangeEventListener) then ThisComponent.Sheets.GetByIndex(0).removeChartDataChangeEventListener(oXChartDataChangeEventListener) '=XChartDataChangeEventListener
end sub
sub XModifyListener_modified(oEvent) '!!! Triggers before changing selection, no way to now what range changed.
end sub
sub XSelectionChangeListener_selectionChanged(oEvent) '!!! deleting cell-contense doesn't trigger this!
sStatusBar ,"S"
EXIT SUB
sStatusBar ,"3 "
bXSelectionChangeListener=true
if isNull(oCurSel) or isNull(oCurCell) or isNull(oPreSel) or isNull(oPreCell) then sInitialize
' msgbox "oPreSel: " & left(a(oPreSel)&" ",9) & " oPreCell: " & a(oPreCell) & " = " & chr(34) & vPreVal & chr(34) & " >>> " & chr(34) & vNewVal & chr(34) & chr(10) & "oCurSel: " & left(a(oCurSel)&" ",9) & " oCurCell: " & a(oCurCell) & " = " & chr(34) & vCurVal & chr(34) & chr(10) & "select: " & left(a(ThisComponent.CurrentSelection)&" ",9) & " CurCell: " & a(o()) & " = " & chr(34) & o().string & chr(34)
if bMouseButton=false then 'selecting done
sStatusBar ,"4 "
oPreSel=oCurSel : oCurSel=ThisComponent.CurrentSelection
endif
sStatusBar ,"5 "
vPreVal=vCurVal : oPreCell=oCurCell
bXSelectionChangeListener=false
sStatusBar ,"6 "
oCurCell=o() : vCurVal=oCurCell.String
sStatusBar ,"7 "
end sub
sub XChartDataChangeEventListener_chartDataChanged(oEvent) '=XChartDataChangeEventListener: 'Triggers after changing selection
sStatusBar ,"D"
EXIT SUB
sStatusBar ,"8 "
if isNull(oCurSel) or isNull(oCurCell) or isNull(oPreSel) or isNull(oPreCell) then sInitialize
vOldVal=vPreVal : oOldSel=oPreSel : oOldCell=oPreCell 'You don't know if XSelectionChangeListener_selectionChanged is still running and changing the globals. Keep it in this order.
vTmpVal=vCurVal : oTmpSel=oCurSel : oTmpCell=oCurCell 'You don't know if XSelectionChangeListener_selectionChanged is still running and changing the globals. Keep it in this order.
' if a(oTmpCell)<>a(o()) then 'XSelectionChangeListener_selectionChanged not jet completed so do it here also.
' oPreCell=oTmpCell : if vPreVal<>vTmpVal then vPreVal=vTmpVal
' if a(oTmpSel)<>a(ThisComponent.CurrentSelection) then oPreSel=oTmpSel
' endif
if bXSelectionChangeListener=true then
sStatusBar ,"9 "
oPreSel=oCurSel
vPreVal=vCurVal : oPreCell=oCurCell
endif
oCurSel=ThisComponent.CurrentSelection : oCurCell=o() : vCurVal=oCurCell.String 'Not shure XSelectionChangeListener_selectionChanged did this already, so do it again to be shure.
vNewVal=oPreCell.String
bPreSelIsOneCell=oPreSel.SupportsService("com.sun.star.sheet.SheetCell")
bCurSelIsOneCell=oCurSel.SupportsService("com.sun.star.sheet.SheetCell")
' if (vOldVal<>vPreVal and vOldVal<>vCurVal) or (a(oOldSel)<>a(oPreSel) and a(oOldSel)<>a(oCurSel)) or (a(oOldCell)<>a(oPreCell) and a(oOldCell)<>a(oCurCell)) or (vTmpVal<>vPreVal and vTmpVal<>vCurVal) or (a(oTmpSel)<>a(oPreSel) and a(oTmpSel)<>a(oCurSel)) or (a(oTmpCell)<>a(oPreCell) and a(oTmpCell)<>a(oCurCell)) then
msgbox vStatusBar _
& chr(10) & "oPreSel: " & left(a(oPreSel)&" ",9) & " oPreCell: " & a(oPreCell) & " = " & chr(34) & vPreVal & chr(34) & " >>> " & chr(34) & vNewVal & chr(34) _
& chr(10) & "oCurSel: " & left(a(oCurSel)&" ",9) & " oCurCell: " & a(oCurCell) & " = " & chr(34) & vCurVal & chr(34) _
& chr(10) & "oOldSel: " & left(a(oOldSel)&" ",9) & " oOldCell: " & a(oOldCell) & " = " & chr(34) & vOldVal & chr(34) _
& chr(10) & "oTmpSel: " & left(a(oTmpSel)&" ",9) & " oTmpCell: " & a(oTmpCell) & " = " & chr(34) & vTmpVal & chr(34)
' endif
sStatusBar "1 "
oCurSel=ThisComponent.CurrentSelection : oCurCell=o() : vCurVal=oCurCell.String
oPreSel=oCurSel : oPreCell=oCurCell : vPreVal=vCurVal
sStatusBar ,"2 "
EXIT SUB
if bListenerPaused then exit sub
' msgbox "Previous selection: " & left(a(oPreSel)&" ",9) & " Previous cell: " & a(oPreCell) & " = " & chr(34) & vPreVal & chr(34) & " >>> " & chr(34) & vNewVal & chr(34) & chr(10) & " Current selection: " & left(a(oCurSel)&" ",9) & " Current cell: " & a(oCurCell) & " = " & chr(34) & vCurVal & chr(340)
if vNewVal<>"" and vNewVal<>vPreVal and bPreSelIsOneCell and bCurSelIsOneCell then '1 cell changed
if vPreVal<>"" then if msgbox ("Waarde " & chr(34) & vPreVal & chr(34) & " overschrijven met " & chr(34) & vNewVal & chr(34) & " ?",33,"Data overschriving") = 2 then sUndo '=cancel
' msgbox "Previous selection: " & left(a(oPreSel)&" ",9) & " Previous cell: " & a(oPreCell) & " = " & chr(34) & vPreVal & chr(34) & " >>> " & chr(34) & vNewVal & chr(34) & chr(10) & " Current selection: " & left(a(oCurSel)&" ",9) & " Current cell: " & a(oCurCell) & " = " & chr(34) & vCurVal & chr(34)
fCheckLine()
elseif fLastRow < vPreLastRow then 'row deleted !
if UCase(InputBox(chr(10) & chr(10) & chr(10) & "Om de volledige lijn(en) te wissen type 'JA':","!!! DELETED LINE(S) !!!"))<>"JA" then sUndo '=cancel
elseif fLastCol < vPreLastCol then 'column deleted !
if UCase(InputBox(chr(10) & chr(10) & chr(10) & "Om de volledige kolom(men) te wissen type 'JA':","!!! DELETED COLUMN(S) !!!"))<>"JA" then sUndo '=cancel
elseif bModified and not bCurSelIsOneCell and a(oCurCell)=a(oPreCell) and oCurSel(0).Columns.Count<255 then 'more then 1 cell changed but not hole line
if msgbox ("Wil u meer dan 1 cell tegelijk wijzigen?!",305,"!!! Meer dan 1 cell gewijzigd !!!") = 2 then sUndo '=cancel
endif
vPreLastRow=fLastRow : vPreLastCol=fLastCol
oCurSel=ThisComponent.CurrentSelection : oCurCell=o() : vCurVal=oCurCell.String
' msgbox "Previous selection: " & left(a(oPreSel)&" ",9) & " Previous cell: " & a(oPreCell) & " = " & chr(34) & vPreVal & chr(34) & " >>> " & chr(34) & vNewVal & chr(34) & chr(10) & " Current selection: " & left(a(oCurSel)&" ",9) & " Current cell: " & a(oCurCell) & " = " & chr(34) & vCurVal & chr(34°
end sub
sub XEventListener_notifyEvent(oEvent as object) '=XEventListener, EventName= OnAlphaCharInput OnNonAlphaCharInput OnModifyChanged OnCopyTo OnCopyToDone OnError OnInsertDone OnInsertStart OnMailMerge OnMailMergeFinished OnNewMail OnMouseOut OnMouseOver OnClick OnMove OnSelect OnFocus OnUnfocus OnNew OnPageCountChange OnPrepareViewClosing OnPrint OnSave OnSaveAs OnSaveAsDone OnSaveDone OnSaveFinished OnLoad OnUnload OnPrepareUnload OnLoadCancel OnLoadDone OnLoadError OnLoadFinished OnCloseApp OnResize OnStartApp OnToggleFullscreen OnViewCreated OnViewClosed
sStatusBar ,"L"
if OEvent.EventName="OnFocus" or OEvent.EventName="OnUnfocus" then exit sub
if oEvent.EventName="OnViewClosed" then
' sStatusBar ,":" & oEvent.EventName & " "
if isNull(oXSelectionChangeListener) then
sStatusBar ,"O"
' sStartEventTrapper
'!!!CAN'T EVEN START THE LOST EVENTS NOW! WHAT ELSE SHOULD I TRY ???
else
sStatusBar ,"X"
sStopEventTrapper
end if
end if
end sub
function XMouseClickHandler_mousePressed(oEvent) as boolean
XMouseClickHandler_mousePressed = False
sStatusBar , "M"
bMouseDoubleClick=(oEvent.ClickCount=2)
if oEvent.Buttons=1 then bMouseButton=true
end function
function XMouseClickHandler_mouseReleased(oEvent) as boolean
XMouseClickHandler_mouseReleased = False
if oEvent.Buttons=1 then bMouseButton=false
end function
function XKeyHandler_KeyPressed(oEvent) as boolean '''Shift, Ctrl and Alt alone doesn't trigger this !!!
XKeyHandler_KeyPressed = False
sStatusBar ,"K"
'if oEvent.KeyCode = com.sun.star.awt.Key.RIGHT then
vChar=oEvent.keyChar
vCode=oEvent.keyCode '256-265:NUM0-NUM9, 512-537:A-Z, 768-793:F1-F26, 1024:DOWN, 1025:UP, 1026:LEFT, 1027:RIGHT, 1028:HOME, 1029:END, 1030:PAGEUP, 1031:PAGEDOWN, 1280:RETURN, 1281:ESCAPE, 1282:TAB, 1283:BACKSPACE, 1284:SPACE, 1285:INSERT, 1286:DELETE, 1287:ADD, 1288:SUBTRACT, 1289:MULTIPLY, 1290:DIVIDE, 1291:POINT, 1292:COMMA, 1293:LESS, 1294:GREATER, 1295:EQUAL, 1296:OPEN, 1297:CUT, 1298:COPY, 1299:PASTE, 1300:UNDO, 1301:REPEAT, 1302:FIND, 1303:PROPERTIES, 1304:FRONT, 1305:CONTEXTMENU, 1306:HELP, 1307:MENU, 1308:HANGUL_HANJA, 1309:DECIMAL, 310:TILDE, 1311:QUOTELEFT, 1536:DELETE_TO_BEGIN_OF_LINE, 1537:DELETE_TO_END_OF_LINE, 1538:DELETE_TO_BEGIN_OF_PARAGRAPH, 1539:DELETE_TO_END_OF_PARAGRAPH, 1540:DELETE_WORD_BACKWARD, 1541:DELETE_WORD_FORWARD, 1542:INSERT_LINEBREAK, 1543:INSERT_PARAGRAPH, 1544:MOVE_WORD_BACKWARD, 1545:MOVE_WORD_FORWARD, 1546:MOVE_TO_BEGIN_OF_LINE, 1547:MOVE_TO_END_OF_LINE, 1548:MOVE_TO_BEGIN_OF_PARAGRAPH, 1549:MOVE_TO_END_OF_PARAGRAPH, 1550:SELECT_BACKWARD, 1551:SELECT_FORWARD, 1552:SELECT_WORD_BACKWARD, 1553:SELECT_WORD_FORWARD, 1554:SELECT_WORD, 1555:SELECT_LINE, 1556:SELECT_PARAGRAPH, 1557:SELECT_ALL
vFunc=oEvent.keyFunc '1:NEW, 2:OPEN, 3:SAVE, 4:SAVEAS, 5:PRINT, 6:CLOSE, 7:QUIT, 8:CUT, 9:COPY, 10:PASTE, 11:UNDO, 12:REDO, 13:DELETE, 14:REPEAT, 15:FIND, 16:FINDBACKWARD, 17:PROPERTIES, 18:FRONT
oMod=oEvent.Modifiers '1=Shift, 2=Ctrl, 4=Alt
if oMod and 1 then vMod=vMod & "+SHIFT"
if oMod and 2 then vMod=vMod & "+CTRL"
if oMod and 4 then vMod=vMod & "+ALT"
' sStatusBar ," " & chr(34) & vChar & chr(34) & vMod & "_" & vCode & "_" & vFunc
if vCode=1283 or vCode=1286 then XKeyHandler_KeyPressed = True
end function
function XKeyHandler_KeyReleased(oEvent) as boolean
XKeyHandler_KeyReleased = False
end function
sub XModifyListener_disposing(oEvent) '=XModifyListener
Msgbox "XModifyListener_disposing !"
end sub
sub XSelectionChangeListener_disposing(oEvent) '=XSelectionChangeListener
oXSelectionChangeListener=nothing '!!! BUG: this is never called, even if going to print-preview which stops this listener !!!
Msgbox "XSelectionChangeListener_disposing !"
end sub
sub XChartDataChangeEventListener_disposing(oEvent) '=XChartDataChangeEventListener
Msgbox "XChartDataChangeEventListener_disposing !" '!!! BUG: this is never called, even if inserting a row which stops this listener !!!
end sub
sub XMouseClickHandler_disposing(oEvent)
oXMouseClickHandler=Nothing 'To know later the handler is lost...
end sub
sub XKeyHandler_disposing(oEvent)
oXKeyHandler=Nothing 'To know later the handler is lost...
end sub
' ---------------------------------- UTILITIES -----------------------------------------
sub sScreenUpdatingOff
ThisComponent.CurrentController.Frame.ContainerWindow.Enable=False
if ThisComponent.isActionLocked=false then ThisComponent.AddActionLock
if ThisComponent.hasControllersLocked=false then ThisComponent.LockControllers
bListenerPaused=true
end sub
sub sScreenUpdatingOn
if ThisComponent.hasControllersLocked=true then ThisComponent.unLockControllers
if ThisComponent.isActionLocked=true then ThisComponent.removeActionLock
ThisComponent.CurrentController.Frame.ContainerWindow.Enable=True
bListenerPaused=false
end sub
sub sUndo()
bListenerPaused=true
oCell=o() 'get activecell
CreateUnoService("com.sun.star.frame.DispatchHelper").ExecuteDispatch(ThisComponent.CurrentController.Frame, ".uno:Undo", "", 0, Array()) '= undo
if not isError(oCell) then ThisComponent.CurrentController.Select(oCell) 'reselect previous activecell
ThisComponent.CurrentController.Select(ThisComponent.CreateInstance("com.sun.star.sheet.SheetCellRanges")) 'unselect any range
bListenerPaused=false
end sub
sub sRedo()
bListenerPaused=true
oCell=o() 'get activecell
'activate undo
CreateUnoService("com.sun.star.frame.DispatchHelper").ExecuteDispatch(ThisComponent.CurrentController.Frame, ".uno:Redo", "", 0, Array())
if not isError(oCell) then ThisComponent.CurrentController.Select(oCell) 'reselect previous activecell
ThisComponent.CurrentController.Select(ThisComponent.CreateInstance("com.sun.star.sheet.SheetCellRanges")) 'unselect any range
bListenerPaused=false
end sub
function a(oIn) 'Gives the address with column-letters and without sheetname or $ from a cell, range or multiple ranges
if isNull(oIn) then a="" : exit function
vOut=oIn.Absolutename
vOut=join(split(vOut,"$"),"") 'replaces all $ with ""
vSheetName=left(vOut,instr(2,vOut,".")) 'get sheetname
a=join(split(vOut,vSheetName),"") 'replaces all sheetnames with ""
end function
function fLastRow() as integer
oSheet = ThisComponent.CurrentController.ActiveSheet
oCursor = oSheet.createCursor()
oCursor.GotoEndOfUsedArea(False)
fLastRow = oCursor.RangeAddress().EndRow
end function
function fLastCol() as integer
oSheet = ThisComponent.CurrentController.ActiveSheet
oCursor = oSheet.createCursor()
oCursor.GotoEndOfUsedArea(False)
fLastCol = oCursor.RangeAddress().EndColumn
end function
function fLastCell() as object
'''fLastCell.cellAddress.Column
oSheet = ThisComponent.CurrentController.ActiveSheet
oCursor = oSheet.createCursor()
oCursor.GotoEndOfUsedArea(False)
vLastColumn = oCursor.RangeAddress().EndColumn
vLastRow = oCursor.RangeAddress().EndRow
fLastCell = oSheet.GetCellByPosition(vLastColumn,vLastRow)
end function
function fUsedRange()
oSheet = ThisComponent.CurrentController.ActiveSheet
oCursor = oSheet.createCursor()
oCursor.gotoStartOfUsedArea(False)
nFirstRow = oCursor.GetRangeAddress().StartRow
nFirstCol = oCursor.GetRangeAddress().StartColumn
oCursor.gotoEndOfUsedArea(False)
nLastRow = oCursor.GetRangeAddress().EndRow
nLastCol = oCursor.GetRangeAddress().EndColumn
fUsedRange = oSheet.GetCellRangeByPosition(nFirstCol,nFirstRow,nLastCol,nLastRow)
end function
sub sSort() 'Sorting all the rows on the active cell or column and returns to the same active cell.
Dim oRange as object
oSheet=ThisComponent.CurrentController.ActiveSheet
oSel=ThisComponent.CurrentSelection
If oSel.GetImplementationName()="ScCellRangesObj" Then 'More then 1 Range selected
msgbox "Sorting only works on selecting 1 cell or 1 group of cells !"
exit sub
endif
oActiveCell=o()
nColSort=oActiveCell.GetCellAddress.Column 'get active-cell-column to sort on
nColStart=0
nColEnd=oSheet.rangeAddress.endColumn
nRowStart=oSel.GetRangeAddress.startRow
nRowEnd=oSel.GetRangeAddress.endRow
nRowMin=1 'sorting from row 1 = row-number 2 !!!
if nRowStart < nRowMin then nRowStart=nRowMin
if nRowEnd <= nRowStart then '1 row selected = select all rows
nRowStart=nRowMin
oUsedRange=oSheet.createCursor() : oUsedRange.gotoStartOfUsedArea(False) : oUsedRange.gotoEndOfUsedArea(True)
nRowEnd=oUsedRange.GetRangeAddress.endRow
endif
oRange=oSheet.GetCellRangeByPosition(nColStart,nRowStart,nColEnd,nRowEnd)
vRetBackColor=RGB(119,19,9) 'unusual color, hopefully the only one in the sheet, to be able to select the same activecell
vPreBackColor=oActiveCell.cellBackColor
oActiveCell.cellBackColor=vRetBackColor
ThisComponent.GetCurrentController.select(oRange)
Dim aSortFields(0) as New com.sun.star.util.sortField
Dim aPropertyValue(0) as New com.sun.star.beans.propertyValue
aSortFields(0).Field = nColSort
aSortFields(0).SortAscending = true
aPropertyValue(0).Name = "SortFields"
aPropertyValue(0).Value = aSortFields()
oRange.Sort(aPropertyValue())
nRow=0
do until nRow>nRowEnd 'lookup previous activecell
oCell=oSheet.GetCellByPosition(nColSort,nRow)
if oSheet.GetCellByPosition(nColSort,nRow).cellBackColor = vRetBackColor then
ThisComponent.GetCurrentController.select(oSheet.GetCellByPosition(nColSort,nRow) 'return to previous active cell
oSheet.GetCellByPosition(nColSort,nRow).cellBackColor=vPreBackColor
exit do
endif
nRow=nRow+1
loop
end sub
function o(optional vChangeColOrRow) as object 'get the activecell with or whitout changing to an other row or column, column=columnname, row+1=number
oActiveSheet=ThisComponent.CurrentController.ActiveSheet
vViewData=ThisComponent.CurrentController.viewData
vViewData=join(split(vViewData,";"),"/") 'replace ; with /
vViewData=join(split(vViewData,":"),"/") 'replace : with /
vViewData=join(split(vViewData,"+"),"/") 'replace + with /
vViewData=split(vViewData,"/") 'split the string
iCol=val(vViewData(6))
iRow=val(vViewData(7))
if not isError(vChangeColOrRow) then 'change row or column
if isNumeric(vChangeColOrRow) then 'change row
iRow=int(val(vChangeColOrRow))
else 'change column
for iCol=0 to 999
if oActiveSheet.GetCellByPosition(iCol,0).String=vChangeColOrRow then exit for
if oActiveSheet.GetCellByPosition(iCol,0).String="" then 'Column-label not found
msgbox "Column-name " & chr(34) & vChangeColOrRow & chr(34) & " is not found !!!"
exit function
endif
next
endif
endif
o=oActiveSheet.GetCellByPosition(iCol,iRow)
end function
sub sStatusBar(optional vNewText, optional vAddText) 'set or add text to the statusbar, nothing = clear&reset it.
if isError(vNewText) then
if isError(vAddText) then 'clear statusbar
vStatusBarText=""
else 'add text to the previous statusbar
vStatusBarText=vStatusBarText & vAddText
endif
else
if isError(vAddText) then 'use new text
vStatusBarText=vNewText
else 'use new text and add the other text as well
vStatusBarText=vNewText & vAddText
endif
endif
if vStatusBarText="" then 'clear statusbar
ThisComponent.CurrentController.StatusIndicator.Reset
else 'change the text in the statusbar
ThisComponent.CurrentController.StatusIndicator.Start(vStatusBarText,0)
'ThisComponent.CurrentController.StatusIndicator.SetText(vStatusBar)
endif
end sub
' ------------------------------ END UTILITIES ---------------------------------------