LibreOfficeでなろうコメント一覧を取って並び替え ２
集計が終わって時間ができたので、マクロを拡張しました。
（今日は代休）
入力シート
出力シート
以下コード。
REM ***** BASIC *****
Sub GetNarouComments()
dim masterSheet as object
mastersheet =ThisComponent.CurrentController.ActiveSheet
dim urlMaster as string
dim i as integer
dim exportBook as object
Dim Dummy()
exportBook = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
dim expSheets as object
expSheets = exportBook.getSheets()
expSheets(0).Name = "取得頁情報一覧"
expSheets.insertNewByName("コメント一覧", 1)
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)
dim newPage as object
newPage = StarDesktop.LoadComponentFromURL(sURL, "_blank", 0, Properties())
exportsFromNewSheet(exportBook)
newPage.close(true)
'Macro1()
wait 200
next i
ReplaceTxts(exportBook)
setExportSheetInfo(exportBook)
msgbox "完了しました"
End Sub
function setExportSheetInfo(export as object)
dim expSheets as object
expSheets = export.getSheets()
dim expInfo as object
dim expComment as object
expInfo = expSheets(0)
expComment = expSheets(1)
expInfo.getcellbyposition(0,0).string = "取得頁"
expInfo.getcellbyposition(1,0).string = "取得時刻"
expInfo.getcellbyposition(2,0).string = "コメントID"
expInfo.getcellbyposition(3,0).string = "ユーザID"
expInfo.getcellbyposition(4,0).string = "名前"
expInfo.getcellbyposition(5,0).string = "投稿日時"
expComment.getcellbyposition(0,0).string = "コメント本文"
expComment.getcellbyposition(1,0).string = "コメントID"
dim i as integer
dim tarCol as object
for i = 0 to 5
tarCol = expInfo.Columns(i)
tarCol.OptimalWidth = true
next i
for i = 0 to 1
tarCol = expComment.Columns(i)
tarCol.OptimalWidth = true
next i
end function
function exportsFromNewSheet(export as object)
dim newBook as object
newBook = thiscomponent
dim pageSheet as object
pageSheet =newBook.CurrentController.ActiveSheet
dim expSheets as object
expSheets = export.getSheets()
dim expInfo as object
dim expComment as object
expInfo = expSheets(0)
expComment = expSheets(1)
dim lastInfo as integer
dim lastUser as integer
dim lastComment as integer
lastInfo = expInfo.getcellbyposition(0,0).value
lastUser = expInfo.getcellbyposition(2,0).value
lastComment = expComment.getcellbyposition(0,0).value
if lastInfo <= 0 then
lastInfo = 1
end if
if lastUser <= 0 then
lastUser = 1
end if
if lastComment <= 0 then
lastComment = 1
end if
dim i as integer
dim sint as integer
dim eint as integer
dim IsComment as boolean
IsComment = false
dim IsComInfo as boolean
IsComInfo = false
dim sTitle as string
sTitle = "<title>"
dim sComment as string
sComment = "<div class=""comment_bun"">"
dim sComInfo as string
sComInfo = "<div class=""comment_info"">"
dim sUserName as string
sUserName = "<a href="
dim sEndSection as string
sEndSection = "</div>"
dim sEndMain as string
sEndMain = "<div id=""sub"">"
dim comId as integer
for i=1 to 20000
dim cellvalue as string
cellvalue = pageSheet.getcellbyposition(0,i).string
if StrComp(cellvalue, sEndSection)=0 then
if IsComment then
IsComment = false
eint = lastComment - 1
elseif IsComInfo then
IsComInfo = false
dim j as integer
for j = sint to eint
expComment.getCellByPosition(1, j).value = comId
next j
end if
elseif StrComp(cellvalue, sComment)=0 then
IsComment = true
sint = lastComment
elseif StrComp(cellvalue, sComInfo)=0 then
IsComInfo = true
comId = lastUser
lastUser = lastUser + 1
elseif IsComment then
expComment.getCellByPosition(0,lastComment).String = cellvalue
lastComment = lastComment + 1
elseif IsComInfo then
if Instr(cellvalue, sUserName) = 1 then
dim userInfo as object
userInfo = split(cellvalue, "/")
expInfo.getcellbyposition(2, comId).value = comId
expInfo.getcellbyposition(3, comId).String = userInfo(1)
expInfo.getcellbyposition(4, comId).String = "<" + userInfo(2) + """>"
else
expInfo.getcellbyposition(5, comId).String = cellvalue
end if
elseif Instr(cellvalue, sTitle) = 1 then
dim titleInfo as object
titleInfo = split(cellvalue, "｜")
expInfo.getCellByPosition(0,lastInfo).String = titleInfo(0) + " (" + lastInfo + ")"
expInfo.getCellByPosition(1,lastInfo).String = now()
lastInfo = lastInfo + 1
elseif StrComp(cellvalue, sEndMain)=0 then
exit for
end if
next i
expInfo.getcellbyposition(0,0).value = lastInfo
expInfo.getcellbyposition(2,0).value = lastUser
expComment.getcellbyposition(0,0).value = lastComment
end function
function ReplaceTxts(export as object)
dim expSheets as object
expSheets = export.getSheets()
dim expInfo as object
dim expComment as object
expInfo = expSheets(0)
expComment = expSheets(1)
dim repRange as object
dim repl as object
repRange = expInfo.getCellRangeByName("A:A")
repl = repRange.createReplaceDescriptor()
repl.SearchString = "<title>"
repl.ReplaceString =""
repl.SearchWords = False
repl.SearchCaseSensitive = False
repRange.replaceAll( repl )
repRange = expInfo.getCellRangeByName("E:E")
repl = repRange.createReplaceDescriptor()
repl.SearchString = "<"">"
repl.ReplaceString =""
repl.SearchWords = False
repl.SearchCaseSensitive = False
repRange.replaceAll( repl )
repRange = expComment.getCellRangeByName("A:A")
repl = repRange.createReplaceDescriptor()
repl.SearchString = "<br />"
repl.ReplaceString =""
repl.SearchWords = False
repl.SearchCaseSensitive = False
repRange.replaceAll( repl )
end function
