LibreOfficeでなろうコメント一覧を取って並び替え

programming

※シャンフロコメント集計用に作成

 

REM  *****  BASIC  *****REM  *****  BASIC  *****
Sub Main dim masterSheet as object mastersheet =ThisComponent.CurrentController.ActiveSheet dim urlMaster as string dim i as integer
Dim Properties(2) As New com.sun.star.beans.PropertyValue Properties(0).Name = "FilterName" Properties(0).Value =  "Text - txt - csv (StarCalc)" Properties(1).Name = "AsTemplate" Properties(1).Value = true Properties(2).Name = "FilterOptions" Properties(2).Value = "0,0,76,1,1" for i = 1 to 10 urlmaster = mastersheet.getcellbyposition(0,i).string Dim sURL As String sURL = ConvertToURL(urlmaster) oDoc = StarDesktop.LoadComponentFromURL(sURL, "_blank", 0, Properties()) Macro1() wait 500 next i msgbox "完了しました" End Sub

 

function Macro1() dim thisbook as object thisbook = thiscomponent dim masterSheet as object mastersheet =thisbook.CurrentController.ActiveSheet dim thissheets as object thissheets = thisbook.getSheets() thissheets.insertNewByName("コメント一覧", 1) dim newsheet as object newsheet = thissheets(1) Dim objController As Object objController = ThisComponent.getCurrentController() objController.setActiveSheet(newsheet) dim i as integer dim insertPos as integer dim dataselect as boolean dataselect = false insertpos = 2 dim sTxt as string dim eTxt as string sTxt = "<div class=""comment_bun"">" eTxt = "</div>" for i=150 to 1000 dim cellvalue as string cellvalue =  mastersheet.getcellbyposition(0,i).string if StrComp(cellvalue, eTxt)=0 then dataselect = false end if if StrComp(cellvalue, sTxt)=0  then dataselect = true else if dataselect then newsheet.getCellByPosition(0,insertpos).String = cellvalue insertpos = insertpos + 1 end if end if next i Macro2() End function
function Macro2()
dim thisbook as object thisbook = thiscomponent dim replaceSheet as object replaceSheet =thisbook.CurrentController.ActiveSheet dim repRange as object repRange = replaceSheet.getCellRangeByName("A:A")
dim repl as object repl = repRange.createReplaceDescriptor() repl.SearchString = "<br />" repl.ReplaceString ="" repl.SearchWords = False    repl.SearchCaseSensitive = False
repRange.replaceAll( repl ) Dim objSortDesc(1) As New com.sun.star.beans.PropertyValue    Dim objSortFields(0) As New com.sun.star.util.SortField        objSortFields(0).Field  = 0     objSortFields(0).SortAscending  = True        objSortDesc(0).Name = "SortFields"    objSortDesc(0).Value = objSortFields()     objSortDesc(1).Name = "ContainsHeader"    objSortDesc(1).Value = False repRange.sort(objSortDesc())  end function