/media/bill/HOWELL_BASE/System_maintenance/LibreOffice/macro_IEEE_prohibited_authors.txt www.BillHowell.ca 09Nov2016 initial, 12Nov2016 now works LibreCalc macro for marking prohibited author papers Based on Howell_ToDos_macLib Executable is in : /home/bill/.config/libreoffice/4/user/basic/Howell_IEEE_prohibited_macLib/Howell_IEEE_prohibited_script.xba LibreOffice Calc macro Currently uses a simple approach, needs refinements for : - data entry problems eg [extra, leading, trailing] spaces - swapped first/last names - common versus formal names REM ***** BASIC ***** ' www.BillHowell.ca 10Nov2016, based on ToDos macro of 17Oct2013 ' LibreOffice list of macros -> Help -> Contents -> Macros & programming -> Command Reference : ' -> Runtime [functions, statements, operators] ' -> Alphabetical list of [functions, statements, operators] 'This completely depends on BOTH sheets being sorted by author last names!!! 'In some case, should use static variables instead of globals 'Many "variables" should be declared as "Constant" 'WARNING! Basic uses 0-based indexing" 'Activate "0_IEEE-CIS Prohibited Authors List...ods" first 'before running! '************************************************* 'Private declarations - apply to whole module, including withing SUBs & Functions ' "Static" variables are declared as Private here Private date_today As Date Private oDocs, oDoc, oSheets, URL As Object Private banSheet, autSheet As Object Private lastrXrfCel, firstXrfCel, affilXrfCel, hittrXrfCel As Object Private row_startBan, row_enderBan As Integer Private row_startAut, row_enderAut, row_fixedAut As Integer Private col_namerBan, col_affilBan As Integer Private col_lastrAut, col_firstAut, col_affilAut As Integer Private col_lastrXrf, col_firstXrf, col_affilXrf, col_hittrXrf As Integer Private namerBanStr, lastrBanStr, firstBanStr As String Private lastrAutStr, firstAutStr As String Private flag_SpreadsheetDoc, row_blankAut As Boolean '************************************************* 'Activate "0_IEEE-CIS Prohibited Authors List...ods" first 'before running! Sub runnit() setup() IF flag_SpreadsheetDoc THEN todays_Date() crawl_banned() ELSE MsgBox "runnit - The current document is NOT a spreadsheet!" End If end Sub Sub dater() setup() IF flag_SpreadsheetDoc THEN todays_Date() ELSE MsgBox "dater - The current document is NOT a spreadsheet!" End If end Sub '************************************************* Sub setup() '+-----+ 'Document oDoc = ThisComponent flag_SpreadsheetDoc = TRUE IsSpreadsheetDoc(oDoc) '+-----+ 'Set up "Banned Author List" sheet banSheet = ThisComponent.Sheets.getByName("Banned Author List") row_startBan = banSheet.GetCellRangeByName("authorBan").RangeAddress.StartRow + 1 row_enderBan = banSheet.GetCellRangeByName("authorBan").RangeAddress.EndRow - 1 col_namerBan = banSheet.GetCellRangeByName("authorBan").RangeAddress.StartColumn col_affilBan = col_namerBan + 1 col_hittrXrf = 0 col_lastrXrf = 1 col_firstXrf = 2 col_affilXrf = 3 '+-----+ 'Set up "IJCNN authors" sheet autSheet = ThisComponent.Sheets.getByName("IJCNN authors") row_startAut = autSheet.GetCellRangeByName("authorAut").RangeAddress.StartRow + 1 row_enderAut = autSheet.GetCellRangeByName("authorAut").RangeAddress.EndRow - 1 row_fixedAut = row_startAut col_lastrAut = autSheet.GetCellRangeByName("authorAut").RangeAddress.StartColumn col_firstAut = col_lastrAut + 1 col_affilAut = col_lastrAut + 2 End Sub '************************************************ Sub crawl_banned() Dim arg, banCell As Object Dim rowBan As Integer DIM commaBanPsn As Long row_blankAut = FALSE For rowBan = row_startBan to row_enderBan ' initiation of "Banned Author List" hittrXrfCel = banSheet.GetCellByPosition(col_hittrXrf, rowBan) lastrXrfCel = banSheet.GetCellByPosition(col_lastrXrf, rowBan) firstXrfCel = banSheet.GetCellByPosition(col_firstXrf, rowBan) affilXrfCel = banSheet.GetCellByPosition(col_affilXrf, rowBan) banCell = banSheet.GetCellByPosition(col_namerBan, rowBan) namerBanStr = banCell.String 'Quit if cell is empty IF "" = namerBanStr THEN 'This should stop the FOR loop - at end of banned list rowBan = row_enderBan + 10 ELSEIF row_blankAut THEN 'This should stop the FOR loop??? - at end of author list rowBan = row_enderBan + 10 ELSE 'commaBanPsn = find(",",namerBanStr) commaBanPsn = InStr(1,namerBanStr,",",0) 'commaBanPsn = InStr(namerBanStr,",") IF commaBanPsn > 0 THEN 'lastrBanStr = mid(namerBanStr,1,commaBanPsn-1) svc = createUnoService( "com.sun.star.sheet.FunctionAccess" ) arg = Array(namerBanStr,1,commaBanPsn-1) lastrBanStr = svc.callFunction("MID",arg) 'firstBanStr = mid(namerBanStr, commaBanPsn+2, len(namerBanStr)-commaBanPsn) svc = createUnoService( "com.sun.star.sheet.FunctionAccess" ) arg = Array(namerBanStr, commaBanPsn+2, len(namerBanStr)-commaBanPsn) firstBanStr = svc.callFunction("MID",arg) crawl_authors (lastrBanStr, firstBanStr) END IF END IF Next rowBan MsgBox( "row_startBan = " + Str(row_startBan) _ + ", row_enderBan = " + Str(row_enderBan) _ + ", rowBan = " + Str(rowBan)) end Sub Sub xrfCel_test() Dim arg, banCell As Object Dim rowBan As Integer DIM commaBanPsn As Long setup() hittrXrfCel = banSheet.GetCellByPosition(col_hittrXrf, 9) lastrXrfCel = banSheet.GetCellByPosition(col_lastrXrf, 9) firstXrfCel = banSheet.GetCellByPosition(col_firstXrf, 9) affilXrfCel = banSheet.GetCellByPosition(col_affilXrf, 9) hittrXrfCel.String = "hittr" lastrXrfCel.String = "lastr" firstXrfCel.String = "first" affilXrfCel.String = "affil" end Sub Sub str_rank_test() As Integer str_rank = StrComp("aak", "baa",0) MsgBox("str_rank_test result",str_rank) End Sub '************************************************ Sub crawl_authors(lastrBanStr As String, firstBanStr As String) Dim lastrAutCel, firstAutCel, affilAutCel As Object Dim lastrAutStr, firstAutStr, affilAutStr As String Dim rowAut As Integer rowAut = row_fixedAut flag_continue = TRUE WHILE flag_continue lastrAutCel = autSheet.GetCellByPosition(col_lastrAut, rowAut) lastrAutStr = lastrAutCel.String IF 0 = StrComp(lastrAutStr, lastrBanStr,0) THEN lastrXrfCel.String = lastrAutStr firstAutCel = autSheet.GetCellByPosition(col_firstAut, rowAut) firstAutStr = firstAutCel.String affilAutCel = autSheet.GetCellByPosition(col_affilAut, rowAut) affilAutStr = affilAutCel.String IF 0 = StrComp(firstAutStr, firstBanStr,0) THEN hittrXrfCel.String = "yes" firstXrfCel.String = firstAutStr affilXrfCel.String = affilAutStr row_fixedAut = rowAut flag_continue = FALSE ELSEIF 1 = StrComp(firstAutStr, firstBanStr,0) THEN 'firstAutStr > firstBanStr 'no change to row_fixedAut firstXrfCel.String = firstAutStr affilXrfCel.String = affilAutStr flag_continue = FALSE ELSEIF -1 = StrComp(firstAutStr, firstBanStr,0) THEN 'firstAutStr < firstBanStr 'no change to row_fixedAut 'continue WHILE, flag_continue remains true firstXrfCel.String = firstAutStr affilXrfCel.String = affilAutStr rowAut = rowAut + 1 ELSE MsgBox("crawl_authors - impossible condition firstAutStr") 'no change to row_fixedAut flag_continue = FALSE End If ELSEIF lastrAutStr = "" THEN 'end of Author list - empty cell row_blankAut = TRUE 'no change to row_fixedAut flag_continue = FALSE ELSEIF 1 = StrComp(lastrAutStr, lastrBanStr,0) THEN 'lastrAutStr > lastrBanStr 'no change to row_fixedAut 'lastrXrfCel.String = "nyet" flag_continue = FALSE ELSEIF -1 = StrComp(lastrAutStr, lastrBanStr,0) THEN 'lastrAutStr < lastrBanStr row_fixedAut = rowAut 'continue WHILE, flag_continue remains true rowAut = rowAut + 1 ELSE MsgBox("crawl_authors - impossible condition lastrAutStr") 'no change to row_fixedAut flag_continue = FALSE End If IF rowAut = row_enderAut - 1 THEN 'no change to row_fixedAut 'lastrXrfCel.String = "nyet" flag_continue = FALSE End If WEND end Sub '************************************************* ' todays_Date() - to avoid recalcs in spreadsheet as much as possible ' www.BillHowell.ca initial 22Mar2014 Sub todays_Date() Dim dateCell As Object dateCell = banSheet.getCellRangeByName("Last_update") dateCell.Value = now end Sub '*************************************************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 flag_SpreadsheetDoc = oDoc.SupportsService(s$) NODOCUMENTTYPE: If Err <> 0 Then flag_SpreadsheetDoc = False Resume GOON GOON: End If End Function 'enddoc enddoc