/media/bill/HOWELL_BASE/System_maintenance/LibreOffice/macro_Howell_ToDos_script.txt www.BillHowell.ca 09Nov2016 initial LibreCalc macro for ToDos [date, count, sort] REM ***** BASIC ***** ' www.BillHowell.ca 17Oct2013 ' LibreOffice list of macros -> Help -> Contents -> Macros & programming -> Command Reference : ' -> Runtime [functions, statements, operators] ' -> Alphabetical list of [functions, statements, operators] '************************************************* Sub ToDos_dateChanges_and_sort () todays_Date() sort_ToDos() Update_date_Changes() color_date() end Sub '************************************************* ' todays_Date() - to avoid realcs in spreadsheet as much as possible ' www.BillHowell.ca initial 22Mar2014 Sub todays_Date() 'Dim oDocs, oDoc, oSheets, oSheet, oCells, oCell, oRange, URL As Object Dim oDocs, oDoc, oSheets, oSheet, oCells, oCell, oRange, URL As Object rem specify the correct file - 29Oct2013 - doesn't workproperly! ' URL line from http://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=60852 ' http://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=58225 'Args(0).Name = "Hidden" 'Args(0).Value = False 'Args(1).Name = "MacroExecutionMode" 'Args(1).Value = 4 'URL = convertToURL("/home/bill/Contacts/0_ToDos.ods") 'oDoc = StarDesktop.loadComponentFromURL(URL, "_blank", 0, Args) 'At least this works - but I don't like "ThisComponent" ' What is the filename approach for "ThisComponent"? oDoc = ThisComponent 'specify correct sheet, ranges oSheet = oDoc.Sheets.getByName("TimeLog") oRange = oSheet.getCellRangeByName("Dates_timeLog") 'May need this form if I can't "convert" the argument from a range to a cell 'oCell = oSheet.getCellByPosition(10, 0) ' GetCell K1 oCell = oSheet.getCellRangeByName("Today") 'find the maximum date, put into "Today" cell 'calling functions : Library.Module.Macro() format 'see /home/bill/System_maintenance/LibreOffice/LibreOffice macros.txt ' 22Mar2014 Calling Calc functions from a macro ' from : FJCC, Moderator, Posts: 3593, Joined: Sat Nov 08, 2008 8:08 pm, Location: Colorado, USA 'svc = createUnoService( "com.sun.star.sheet.FunctionAccess" ) 'arg = Array(SearchValue, oCellRange, Column, Mode) 'Value = svc.callFunction("VLOOKUP",arg) 'oCell.Value = Library.Module.Macro() maximum(oRange) svc = createUnoService( "com.sun.star.sheet.FunctionAccess" ) arg = Array(oRange) oCell.Value = svc.callFunction("MAX",arg) end Sub '************************************************* 'Examples : ' /home/bill/System maintenance/LibreOffice/Pitonyak 130321 Useful Macro Information For OpenOffice.odt ' page 151 ' Assume that I want to sort on the second and third columns where the first column is text and ' the second column is to be sorted numerically. I will need two sort fields rather than one. Sub sort_ToDos () 'Dim oDocs, oDoc, oSheets, oSheet, oCells, oCell, oRange, URL As Object Dim oDocs, oDoc, oSheets, oSheet, oCells, oCell, oRange As Object Dim oSortFields(2) As New com.sun.star.util.SortField Dim oSortProperties(2) As New com.sun.star.beans.PropertyValue 'Howell - was aSortDesc(0) !! Dim Args(1) As new com.sun.star.beans.PropertyValue Dim col_dateOriginl, col_priority As Integer Dim oString As String rem specify the correct file - 29Oct2013 - doesn't workproperly! ' URL line from http://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=60852 ' http://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=58225 'Args(0).Name = "Hidden" 'Args(0).Value = False 'Args(1).Name = "MacroExecutionMode" 'Args(1).Value = 4 'URL = convertToURL("/home/bill/Contacts/0_ToDos.ods") 'oDoc = StarDesktop.loadComponentFromURL(URL, "_blank", 0, Args) 'At least this works - but I don't like "ThisComponent" ' What is the filename approach for "ThisComponent"? oDoc = ThisComponent 'specify correct sheet, select the range to sort oSheet = oDoc.Sheets.getByName("ToDos") oRange = oSheet.getCellRangeByName("ToDos_sortRange") ThisComponent.getCurrentController.select(oRange) 'oDoc.getCurrentController.select(oRange) 'Remember that the fields are zero based so this starts sorting in column B, not column A col_dateCurrent = oSheet.GetCellRangeByName("Date").RangeAddress.StartColumn col_priority = oSheet.GetCellRangeByName("priority").RangeAddress.StartColumn 'Another valid sort type is 'com.sun.star.util.SortFieldType.AUTOMATIC 'It turns out that there is no reason to set the field type while 'sorting in a spreadsheet document because this is ignored. 'A spreadsheet alraedy knows the type. Can also use ALPHANUMERIC oSortFields(0).Field = col_dateCurrent oSortFields(0).SortAscending = TRUE oSortFields(0).FieldType = com.sun.star.util.SortFieldType.NUMERIC oSortFields(1).Field = col_priority oSortFields(1).SortAscending = TRUE oSortFields(1).FieldType = com.sun.star.util.SortFieldType.NUMERIC oSortProperties(0).Name = "SortFields" oSortProperties(0).Value = oSortFields() ' oSortFields(0) 'To specify the first row as a header row, use another property. Be certain that you dimension enough properties. oSortProperties(1).Name = "ContainsHeader" oSortProperties(1).Value = True 'Two key additional sorting statements to do >3 column macro sorts! : '24Oct2013 Unlimited Sort Columns & Custom Sort Order Using Basic 'http://forum.openoffice.org/en/forum/viewtopic.php?f=75&t=44334 'Postby alsOO ยป Mon Oct 03, 2011 1:33 am ' the next two statements enable use of a custom sort order defined in Data/Sorts,,,/Options/Custom Sort Order ' note: I only have ONE custom sort order defined. I did not test with multiple custom sort orders 'sortProperties(1).Name = "IsUserListEnabled" 'sortProperties(1).Value = TRUE oRange.Sort(oSortProperties()) ' aSortDesc(0) ' 29Oct2013 - add this to deselect oRange and move cursor to "A6" ' easy - put currentdate in cell "current date" as in ToDos_Month_Count_update_call () oString = "Latest update - Date: " & str(day(now())) & "-" & str(month(now())) & "-" & str(year(now())) & " Time: " & str(hour(now())) & ":" & str(minute(now())) oCell = oSheet.getCellByPosition(10, 0) ' GetCell K1 oCell.string = oString 'The abovecode didn't work? - how to move cursor? 'Fudge for now oRange = oSheet.getCellRangeByName("longTerm") ThisComponent.getCurrentController.select(oRange) end Sub '************************************************* Sub Update_date_Changes () Dim oDocs, oDoc, oSheets, oSheet, oCells, oCell, oRange, URL As Object Dim jRow As Integer Dim row_start As Integer Dim row_ender As Integer oDoc = ThisComponent oSheet = ThisComponent.Sheets.getByName("ToDos") row_start = oSheet.GetCellRangeByName("dates_Old").RangeAddress.StartRow + 1 row_ender = oSheet.GetCellRangeByName("dates_Old").RangeAddress.EndRow - 1 For jRow = row_start to row_ender increment_dateChanges(jRow) Next jRow end Sub '************************************************* Sub increment_dateChanges(iRow As Integer) ' specify the correct document, file, sheet Dim oDocs, oDoc, oSheets, oSheet, oCells, oCell, oRange As Object Dim oCol, oCols() As Integer Dim oString As String Dim cel_dateOriginl As Object, col_dateOriginl As Integer, dateOriginl As Date Dim cel_dateCurrent As Object, col_dateCurrent As Integer, dateCurrent As Date Dim cel_dateChanges As Object, col_dateChanges As Integer, dateChanges As Integer ' change 1-to-zero-based array indexing oRow = iRow ' Test to see if current document is a spreadsheet, and if so, proceed oDoc = ThisComponent If IsSpreadsheetDoc(oDoc) THEN oSheet = ThisComponent.Sheets.getByName("ToDos") 'oCell = RetrieveTheActiveCell() 'Paolo Mantovani's macro, from www.pitonyak.org/AndrewMacro.odt ' constants - you hope these don't change! zero indexing of cols & rows 'The following commented-out expression successfully retrieved values col_dateOriginl = oSheet.GetCellRangeByName("dates_Old").RangeAddress.StartColumn col_dateCurrent = oSheet.GetCellRangeByName("Date").RangeAddress.StartColumn col_dateChanges = oSheet.GetCellRangeByName("date_chgs").RangeAddress.StartColumn 'col_dateOriginl = cel_dateOriginl.RangeAddress.StartColumn 'col_dateCurrent = cel_dateCurrent.RangeAddress.StartColumn 'col_dateChanges = cel_dateChanges.RangeAddress.StartColumn ' get cell references 'These DID work in subsequent code to get cell values, but didn't work with assingmentof values cel_dateCurrent = osheet.GetCellByPosition(col_dateCurrent,oRow) cel_dateOriginl = osheet.GetCellByPosition(col_dateOriginl,oRow) cel_dateChanges = osheet.GetCellByPosition(col_dateChanges,oRow) 'These did NOT work in subsequent code to get cell values 'cel_dateOriginl = osheet.GetCellRangeByName("Date_Recent") 'cel_dateCurrent = osheet.GetCellRangeByName("Date") 'cel_dateChanges = osheet.GetCellRangeByName("date_chgs") ' get current info dateCurrent = cel_dateCurrent.value dateOriginl = cel_dateOriginl.value dateChanges = cel_dateChanges.value IF dateCurrent <> dateOriginl THEN dateChanges = dateChanges + 1 'neither of these approaches seems to work? cel_dateChanges.setValue(dateChanges) 'osheet.GetCellByPosition(col_dateCurrent,oRow).value = dateChanges 'cel_dateChanges.Value = dateChanges cel_dateOriginl.Value = dateCurrent End If ' end of original document test - if the document was NOT a spreadsheet, THEN an error message is generated ELSE MsgBox "The current document is NOT a spreadsheet!" End If 'end Function end Sub '************************************************* 'help from : 'http://stackoverflow.com/questions/12089051/changing-cell-background-color-in-libreoffice 'http://rapidtables.com/web/color/RGB_Color.htm 'http://www.debugpoint.com/2014/11/date-and-time-processing-in-libreoffice-calc-using-macro/ Sub color_date ()n Dim oDocs, oDoc, oSheets, oSheet, oCells, oCell, oRange, URL As Object Dim jRow As Integer Dim row_start As Integer Dim row_ender As Integer Dim col_start As Integer Dim cell_date_today, cell_date_DrumExercise, cell_date_DrumShop, cell_date_MomDad, cell_date_longTerm As Object Dim date_today, date_DrumExercise, date_DrumShop, date_MomDad, date_longTerm As Date color_today = RGB(255,150,150) 'red color_DrumExercise = RGB(40,180,40) 'green dark color_DrumShop = RGB(150,250,150) 'green light color_MomDad = RGB(255,180,100) 'tan light color_longTerm = RGB(200,200,200) 'grey color_white = RGB(255,255,255) 'white oDoc = ThisComponent If IsSpreadsheetDoc(oDoc) THEN oSheet = ThisComponent.Sheets.getByName("ToDos") row_start = oSheet.GetCellRangeByName("Dates").RangeAddress.StartRow + 1 row_ender = oSheet.GetCellRangeByName("Dates").RangeAddress.EndRow - 1 col_start = oSheet.GetCellRangeByName("Dates").RangeAddress.StartColumn cell_date_today = oSheet.GetCellRangeByName("Todayer") cell_date_DrumExercise = oSheet.GetCellRangeByName("Drumheller_exercise") cell_date_DrumShop = oSheet.GetCellRangeByName("Drumheller_shop") cell_date_MomDad = oSheet.GetCellRangeByName("MomDad_visit") cell_date_longTerm = oSheet.GetCellRangeByName("longTerm") date_today = cell_date_today.Value date_DrumExercise = cell_date_DrumExercise.Value date_DrumShop = cell_date_DrumShop.Value date_MomDad = cell_date_MomDad.Value date_longTerm = cell_date_longTerm.Value For jRow = row_start to row_ender oCell = oSheet.GetCellByPosition(col_start, jRow) cell_date = oCell.value Select Case cell_date Case date_today oCell.CellBackColor = color_today Case date_DrumExercise oCell.CellBackColor = color_DrumExercise Case date_DrumShop oCell.CellBackColor = color_DrumShop Case date_MomDad oCell.CellBackColor = color_MomDad Case date_longTerm oCell.CellBackColor = color_longTerm Case Else oCell.CellBackColor = color_white End Select Next jRow ' end of original document test - if the document was NOT a spreadsheet, THEN an error message is generated ELSE MsgBox "The current document is NOT a spreadsheet!" End If end Sub '************************************************* Function fudgy (iBool As Boolean) As Boolean ' I tried this to effectively use a function in a cell that has side-effects, but it didn't work 'increment_dateChanges() fudgy = iBool end Function '****************************************************************** '****************************************************************** ' Macros by others used as examoles of techniques, grammar etc '****************************************************************** ' from : http://suite101.com/a/openoffice-macros-accessing-calc-cells-a64264 ' 131018 This doesn't work!!! ' I changed "Sub" to "junction" (and "End Sub" as well, of course) -> still doesn't work! ' Oops - I changed theSheetspecification - now it works! Function writeToCells Dim Sheet, Cell Dim c as Integer, r as Integer 'Sheet = thisComponent.Sheets("Todos") Sheet = ThisComponent.Sheets.getByName("ToDos") Cell = Sheet.getCellRangeByName("A1") Cell.String = "Values" c = 0 for r = 1 to 10 Cell = Sheet.getCellByPosition(c, r) Cell.Value = r next r Cell = Sheet.getCellRangeByName("B1") Cell.String = "Totals" Cell = Sheet.getCellRangeByName("B2") Cell.Formula = "=SUM(A2:A11)" End Function '****************************************************************** ' http://disemia.com/software/openoffice/macro_arrays.html via from www.pitonyak.org/AndrewMacro.odt ' Return the sequence of Fibonacci numbers ' assume that count >=2 is to make this code simpler ' Howell 17Oct2013 - returns a list , which doen't enter into a cell.. . Function Fibonacci( nCount As Integer ) If nCount < 2 Then nCount = 2 Dim result( 1 to nCount) As Double Dim i As Integer result( 1) = 0 result( 2) = 1 For i = 3 to nCount result(i) = result( i - 2) + result( i - 1) Next i Fibonacci = result() End Function rem Neat - the following produces a MsgBox!! rem Print #0, "UC" rem Print #1, "UC" - doesn't work rem oString = "Latest update - Date: " & str(day(now())) & "-" & str(month(now())) & "-" & str(year(now())) & " Time: " & str(hour(now())) & ":" & str(minute(now())) rem oCell.string = oString 'Print oCell.getValue() 'Print oCell.getString() 'Print oCell.getFormula() '*************************************************8 ' Listing 6.1: Is this a Calc document, using error handling. Function IsSpreadsheetDoc(oDoc) As Boolean Dim s$ : s$ = "com.sun.star.sheet.SpreadsheetDocument" On Local Error GoTo NODOCUMENTTYPE IsSpreadsheetDoc = oDoc.SupportsService(s$) NODOCUMENTTYPE: If Err <> 0 Then IsSpreadsheetDoc = False Resume GOON GOON: End If End Function 'enddoc enddoc