Macro for removing lines has a problem

English
,
#1

Hi all, I have some Basic code that jumps to a certain point in a document, then deletes some lines. This works fine, but I need to add some intelligence into this. Sometimes there are no lines to delete, sometimes there are 1, 2 or 3 lines to remove. In every case, there is a table that I need to stop at.

I’ve tried to use the text cursor method, but I don’t understand how you can determine where it puts this cursor, also when I tell the cursor to move, then inspect the string, it doesn’t change, telling me the cursor isn’t actually moving around.

The table text is fixed. I have created a test document to try and get it working properly. In the real document, there is a ToC, hence the search loop.
TableProblemDocTest.odt (12.3 KB)

This is my working code. I’m sure it can be written better, there was a lot of copy/pasting going on here from lots of different sources. But I’m struggling to understand how the text cursor works.

My thinking is, search for the correct place in the document, jump to it, read the next line, if it does not start with “Version” (the table), delete the line, loop. The only thing I want is the heading and the table on the next line.

LO Version: 7.6.4.1 (X86_64)
Windows 10

Sub DeleteLines

Dim runNumber As integer
Dim document As object
Dim dispatcher As Object
Dim linePos(1) As new com.sun.star.beans.PropertyValue
Dim findHeading(0) As new com.sun.star.beans.PropertyValue
	
	document = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	'Define the search pattern for finding "Change History"
	findHeading(0).Name = "SearchItem.SearchString"
	findHeading(0).Value = "Change History"

	'Run the search twice, because the first result is in the Contents
	For runNumber = 1 To 2
		dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, findHeading()) 			
	Next runNumber
	
	'Define the line movement			
	linePos(0).Name = "Count"
	linePos(0).Value = 1
	linePos(1).Name = "Select"
	linePos(1).Value = false
	
	dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, linePos())
	dispatcher.executeDispatch(document, ".uno:Delete", "", 0, Array())
	dispatcher.executeDispatch(document, ".uno:Delete", "", 0, Array())
	dispatcher.executeDispatch(document, ".uno:Delete", "", 0, Array())

End Sub
#2

Did I understand this phrase correctly? “Need to remove extra paragraphs (blank and possibly non-blank) between the “Change History” line and the table slightly below”?

#3

Yes that’s correct. The test document I uploaded shows two extra lines after the heading “Change History”, those lines I need to remove and just leave the table underneath.

#4

Test this:

Sub removeLines 'remove empty or only with "spaces" lines between searched text and table
	on local error goto bug
	dim oDoc as object, oDesc as object, oVCur as object, oFound as object, s$, calc as object, i&, bOk as boolean, undoMgr as object
	const cUndo="Delete empty lines before Tables" 'string for Undo/Redo
	
	const cFind="Change History" 'searched phrase
	
	calc=CreateUnoService("com.sun.star.sheet.FunctionAccess") 'function from Calc
	oDoc=ThisComponent
	oDoc.lockControllers 'turn off the screen rendering (it is faster)
	undoMgr=oDoc.UndoManager
	undoMgr.enterUndoContext(cUndo)
	
	oVCur=oDoc.CurrentController.ViewCursor
	oDesc=oDoc.createSearchDescriptor
	oDesc.SearchString=cFind
	oVCur.goToStart(false) 'visible cursor to start of document
	
	
	oFound=oDoc.findFirst(oDesc) 'find 1st phrase
	do while NOT IsNull(oFound)
		with oVCur
			.goToRange(oFound.End, false) 'move visible cursor to end of searched string
			.goToEndOfLine(false)
			.goRight(1, false) 'visible cursor is at start of next line
		end with
		
		do while true 'delete empty lines
			oVCur.goToEndOfLine(true)
			bOK=true
			if Len(oVCur.String)>0 then 'it is not empty line
				s=Calc.callFunction("REGEX", array(oVCur.String, "^\s*$")) 'test line for regex characters \s
				if Len(s)=Len(oVCur.String) then 'line has only spaces so delete line
					with oVCur 'delete line
						.collapseToEnd
						.goToStartOfLine(true)
						.goLeft(1, true)
						.String=""
					end with
					bOk=false
				end if
			end if
			
			if bOk then 'test next line
				oVCur.goRight(1, false)
				if isEmpty(oVCur.Cell) then 'cursor isn't in table
					with oVCur 'delete line
						.goLeft(1, true)
						.String=""
					end with
				else 'cursor is in table
					exit do 'so empty lines are deleted
				end if
			end if
		loop
		
		oFound=oDoc.findNext(oFound.End,  oDesc) 'find next phrase
	loop
	
	undoMgr.leaveUndoContext(cUndo)
	oDoc.unlockControllers
	exit sub
bug:
	if oDoc.hasControllersLocked then oDoc.unlockControllers
	msgbox(Error & chr(13) & "Line: " & Erl & chr(13) & Err, 16)
End Sub
#5

I made some changes to my code (see below) that worked apart from one use case, a single line under the heading with at least one space in it. For some reason it doesn’t delete it, it will just go around in the loop infinitely (hence the runNumber check), any other combination is ok, even a single line on its own with no spaces.

@KamilLanda I tried your version, but it falls over if there is just one line present to start with. I like the way you have used the visible cursor and the undo manager. I didn’t know about that, I’m going to look into that for the future. Stopping the updates to the screen I have used already in the main macro code. Your code has given me some ideas to try out.

Dim runNumber As integer
Dim document As object
Dim dispatcher As Object
Dim linePos(1) As new com.sun.star.beans.PropertyValue
Dim findHeading(0) As new com.sun.star.beans.PropertyValue
Dim viewCursorPosition As Object
Dim textObject As Object
Dim cursorObject As Object

Const  MAX_RUN = 20
	
'Define the search pattern for finding "Change History"
findHeading(0).Name = "SearchItem.SearchString"
findHeading(0).Value = "Change History"
	
'Define the line movement			
linePos(0).Name = "Count"
linePos(0).Value = 1
linePos(1).Name = "Select"
linePos(1).Value = false
	
	document = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	'Run the search twice, because the first result is in the Contents
	For runNumber = 1 To 2
		dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, findHeading()) 			
	Next runNumber
	
	'The view cursor knows about lines and pages, the regular cursors know about words, sentences, and paragraphs.
	viewCursorPosition = ThisComponent.getCurrentController().getViewCursor()
	
	'Position the cursor and get the text
	dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, linePos())
	textObject = viewCursorPosition.getText()
	cursorObject = textObject.createTextCursorByRange(viewCursorPosition)
	
	runNumber = 0 're-initialise this again to use it in this loop
	
	'Delete a line until the table is reached. 
	'Need to prevent an infinite loop. A single line above the table with one or more spaces does not get deleted for some reason
	'and just loops continually. A single line with no spaces is ok. A single line with any number of spaces with a line above is also fine.
	Do  While cursorObject.ParaStyleName <> "Table Heading"  And runNumber < MAX_RUN
		runNumber = runNumber + 1 'use this as an escape route to prevent an infinite loop
		dispatcher.executeDispatch(document, ".uno:Delete", "", 0, Array())
		textObject = viewCursorPosition.getText()
		cursorObject = textObject.createTextCursorByRange(viewCursorPosition)
	Loop
	
End Sub
#6

fixed version:

Sub removeLines2 'remove empty or only with "spaces" lines between searched text and table
	on local error goto bug
	dim oDoc as object, oDesc as object, oVCur as object, oFound as object, s$, calc as object, i&, bOk as boolean, undoMgr as object, iLen&
	const cUndo="Delete empty lines before Tables" 'string for Undo/Redo
	
	const cFind="Change History" 'searched phrase
	
	calc=CreateUnoService("com.sun.star.sheet.FunctionAccess") 'function from Calc
	oDoc=ThisComponent
	oDoc.lockControllers 'turn off the screen rendering (it is faster)
	undoMgr=oDoc.UndoManager
	undoMgr.enterUndoContext(cUndo)
	
	oVCur=oDoc.CurrentController.ViewCursor
	oDesc=oDoc.createSearchDescriptor
	oDesc.SearchString=cFind
	oVCur.goToStart(false) 'visible cursor to start of document
		
	oFound=oDoc.findFirst(oDesc) 'find 1st phrase
	do while NOT IsNull(oFound)
		with oVCur
			.goToRange(oFound.End, false) 'move visible cursor to end of searched string
			.goToEndOfLine(false)
			.goRight(1, false) 'visible cursor is at start of next line
		end with
			
		do while true 'delete empty lines
			if NOT isEmpty(oVCur.Cell) then exit do 'cursor is in table cell
			oVCur.goToEndOfLine(true)
			iLen=Len(oVCur.String)
			if iLen>0 then 'it isn't empty line
				s=Calc.callFunction("REGEX", array(oVCur.String, "^\s*$")) 'test line for regex characters \s
				if Len(s)=Len(oVCur.String) then 'line has only spaces so delete line
					with oVCur 'delete line
						.collapseToEnd
						.goToStartOfLine(true)
						.goLeft(1, true)
						.String=""
					end with
				end if
			else 'empty line
				with oVCur 'delete line
					.goLeft(1, true)
					.String=""
				end with
			end if
			oVCur.goRight(1, false)
			if NOT isEmpty(oVCur.Cell) then exit do 'cursor is in table cell
		loop
		
		oFound=oDoc.findNext(oFound.End,  oDesc) 'find next phrase
	loop
	
	undoMgr.leaveUndoContext(cUndo)
	oDoc.unlockControllers
	exit sub
bug:
	if oDoc.hasControllersLocked then oDoc.unlockControllers
	msgbox(Error & chr(13) & "Line: " & Erl & chr(13) & Err, 16)
End Sub
#7

@KamilLanda, thanks, it looks like your v2 is now working as I want it to. It’s also given me some insight into other ways of coding this.

Thanks again.

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.