LibreOffice Writer Macro to extract Text and Table with multiple condition in a new document

Delete empty line between

conditions=array( _
array("condition1", ...), _

array("conditon", ...) _
)

1 Like

I wish whatever I enter in sText box should support regular expression e.g. Evidence|Judgment etc.

Sub EnterAndExtract 'extract parts of text to new document, the array in conditions() has the conditions for one new document
	dim oDoc as object, oFound as object, oCur as object, o1 as object, o2 as object, i&, calc as object, s$, regex$, copy as object, oTable as object, _
		oDesc1 as object, oDesc2 as object, p(), cond, oDocNew as object, oVCurNew as object, args(0) as new com.sun.star.beans.PropertyValue
		args(0).Name="Hidden" : args(0).Value=true
	const repl="@@@" 'replacement for | in conditions, because the whole regexp 'condition1|condition2|condition3|...' is searched
	const iEnters=4 'count of empty paragraphs in new document between pasted text

rem define variables
dim dispatcher as object
Dim sText As String
sText = ""
rem ----------------------------------------------------------------------
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------

rem ----------------------------------------------------------------------
sText = InputBox("Please enter the text string e.g. Bail papers, Vakalatna filed for, Deposition etc.", "Roznama Setting Shortcut by Mr. Aniruddha Mohod, Amravati (Maharashtra)")

	'add new array("condition1", "condition2", ...) next new document
	conditions=array( _
		array(sText), _
	)

	oDoc=ThisComponent
	calc=CreateUnoService("com.sun.star.sheet.FunctionAccess") 'function from Calc
	oCur=oDoc.Text.createTextCursor 'Text cursor in document
	oDesc1=oDoc.createSearchDescriptor
	with oDesc1 'for searching 
		.SearchString="IN\s+THE\s+COURT\s+OF|यांचे\s+न्यायालयात\s"
		.SearchRegularExpression=true
		.SearchBackwards=true
	end with
	oDesc2=oDoc.createSearchDescriptor
	with oDesc2
		.SearchString="^-{5,}$"
		.SearchRegularExpression=true
		.SearchBackwards=false
	end with
	
	for each cond in conditions
		redim p(ubound(cond))
		for i=lbound(cond) to ubound(cond) 'spaces in user conditions are transformed to regexp: \s+
			s=calc.callFunction("REGEX", array(cond(i), "\s+", "\\s+", "g"))
			p(i)=replace(s, "|", repl) 'replace the | in conditions
		next i
		regex=join(p, "|") 'string with conditions for regex -> condition1|condition2|condition3
		oDocNew=StarDesktop.loadComponentFromUrl("private:factory/swriter", "_blank", 0, args) 'new document
		oVCurNew=oDocNew.CurrentController.ViewCursor
		rem search TextTables for regex condition
		for each oTable in oDoc.TextTables
			if searchInTable(oTable, regex, repl) then 'text in table is found
				o1=oDoc.findNext(oTable.Anchor, oDesc1) 'find IN THE COURT OF before table
				if NOT isNull(o1) then 'IN THE COURT OF is found
					o2=oDoc.findNext(oTable.Anchor, oDesc2) 'find line with -----
					if NOT isNull(o2) then 'line ----- is found
						oCur.goToRange(o1.Start, false)
						oCur.goToRange(o2.End, true)
						copy=oDoc.CurrentController.getTransferableForTextRange(oCur)
						oDocNew.CurrentController.insertTransferable(copy)
						for i=1 to iEnters 'add blank paragraphs to new document to has spaces between pasted parts
							oVCurNew.goToEnd(false)
							oDocNew.Text.InsertControlCharacter(oVCurNew.End, com.sun.star.text.ControlCharacter.APPEND_PARAGRAPH, false) 'add new Paragraph
						next i
						oVCurNew.goToEnd(false)
					end if
				end if
			end if
		next
		oDocNew.CurrentController.Frame().ContainerWindow.Visible=true
	next
End Sub

Function searchInTable(oTable as object, regex$, repl$) as boolean 'return true if regex is found in oTable; repl is substitution for | if text in cell has |
	dim dataArray(), row, cell, calc as object, s$
	calc=CreateUnoService("com.sun.star.sheet.FunctionAccess")
	dataArray=oTable.DataArray
	for each row in dataArray
		for each cell in row
			s=replace(cell, "|", repl) 'replace | in text from table for proper searching with regex condtion1|condition2|condition3
			s=calc.callFunction("REGEX", array(s, regex))
			if s<>"" then 'FOUND text in table
				searchInTable=true
				exit function
			end if
		next
	next
	searchInTable=false
End Function