I am using Ubuntu 22.04 and LibreOffice 7.5.5.2. I want to create a macro that will place a Database field and Next record field before every occurrences of phrase “Case No.: “.
Thanks in advance.
I know that if I copy the “Case No.:” , database field, next record field and find all “Case No.:” then paste it with “Case No.:” , database field, next record my problem will solve. But I want it to be done with macro.
@KamilLanda @karolus Please tell me whether it is possible or not. I can do it manually but for most of my colleagues it will be difficult to do manually. This is also 10% of my overall project. (I don’t have knowledge of any programming language. I just learned FoxPro in 1998)
I think it will be possible to write some macro :-), but I need some ODT with example (because I don’t know what is “database field” and “next record field” and example is better than next description).
Only 1-2 pages will suffice 
→ for example 1st page with current state and 2nd page with the result you want to have (with the result you make manually).
Result I Want.odt (62.0 KB)
Current State.odt (61.7 KB)
Roznama Vlookup.ods (209.2 KB)
Sending all pages and files. You can suggest me more possible improvements. 
Unfortunately I don’t know how to work with database fields manually much less by macro, extra joined from Writer to Calc 
; but I suppose it will be more complicated. So I made macro that load data from Calc and put it to Writer as normal text.
There is string without dots in ODS, but there are dots&spaces for this string in Writer → SCC/304357/2012 → S.C.C. / 304357 / 2012. Macro searches with regexp and I suppose the dost are only in 1st part of string (S.C.C.), so it adds the dots (only dots, no other marks) and spaces to the searched regexp → S\.*C\.*C\.*\s*/\s*304357\s*/\s*2012.
Macro supposes the Roznama Vlookup.ods is in the same directory as Current State.odt, if not then change the variable sUrl.
And constant cSheetName is for the name of sheet in ODS, that is Sheet3 now.
Sub addDataFromODS
on local error goto bug
rem ODS info
const cODSname="Roznama Vlookup.ods", cSheetName="Sheet3"
dim oDoc as object, sUrl$, p()
oDoc=ThisComponent 'current ODT
p=split(oDoc.URL, "/") : p(ubound(p))=cODSname 'your ODS is in the same directory like current ODT
sUrl=join(p, "/") 'URL to ODS
rem get data from ODS
dim ODS as object, oSheet as object, oRange as object, oCur as object, data(), args(0) as new com.sun.star.beans.PropertyValue
args(0).Name="Hidden" : args(0).Value=true
ODS=StarDesktop.loadComponentFromUrl(sUrl, "_blank", 0, args()) 'open ODS as hidden
oSheet=ODS.Sheets.getByName(cSheetName)
oCur=oSheet.createCursor : oCur.goToEndOfUsedArea(false) 'detect last cell in sheet
oRange=oSheet.getCellRangeByPosition(0, 1, 1, oCur.RangeAddress.EndRow) '1st and 2nd column without 1 row
data=oRange.getDataArray() 'data from oRange
ODS.close(true)
rem modify ODT
dim i&, s$, oStatusbar as object, oDesc as object, j&, iLen&, oFound as object, oVCur as object, undoMgr as object, sUndo$
oStatusbar=oDoc.CurrentController.StatusIndicator 'progressbar in Statusbar
oStatusbar.start("", ubound(data))
oVCur=oDoc.CurrentController.ViewCursor 'visible cursor
undoMgr=oDoc.UndoManager 'object for Undo/Redo
oDoc.lockControllers 'no screen rendering, faster
oDesc=oDoc.createSearchDescriptor
oDesc.SearchRegularExpression=true
for i=lbound(data) to ubound(data)
p=split(data(i)(0), "/")
iLen=Len(p(0)) : s=""
for j=1 to iLen 'adapt the string from ODS, for example SCC/304357/2012 -> S\.*C\.*C\.*\s*/\s*304357\s*/\s*2012
s=s & Mid(p(0), j, 1) & "\.*" '!!! regular expression supposes only dots among letters, no other marks (SCC -> S.C.C.)
next j
p(0)=s
oDesc.SearchString=join(p, "\s*/\s*")
oFound=oDoc.findFirst(oDesc)
if NOT isNull(oFound) then
sUndo=data(i)(0) & " " & data(i)(1)
undoMgr.enterUndoContext(sUndo) 'title for Undo
oDoc.CurrentController.Select(oFound)
with oVCur
.goToRange(oFound.Start, false)
.goToStartOfLine(false)
.String=" "
.collapseToStart
.CharWeight=com.sun.star.awt.FontWeight.BOLD 'set the bold format
.String=data(i)(1) & ")" 'Sr. No.
.goUp(1, false)
.goToStartOfLine(false)
oDoc.Text.insertControlCharacter(oVCur.End, com.sun.star.text.ControlCharacter.LINE_BREAK, false) 'add Shift+Enter at the top of Found
.goUp(1, false)
.String=data(i)(0) 'Act Section
end with
undoMgr.leaveUndoContext(sUndo) 'more operations (Sr. No. + Act Section) as one operation for Undo
end if
if i MOD 10=0 then oStatusbar.setValue(i) 'update statusbar
next i
oVCur.goToStart(false)
if oDoc.hasControllersLocked then oDoc.unlockControllers 'screen rendering yes
oStatusbar.end : oStatusbar.reset
exit sub
bug: 'some error
if NOT isNull(ODS) then ODS.close(true)
if oDoc.hasControllersLocked then oDoc.unlockControllers
msgbox("line: " & Erl & chr(13) & Err & ": " & Error, 16, "addDataFromODS")
End Sub
Only typical suggestion: Styles instead direct formatting .
In case of style, if I select all - go to style – edit style – Text flow Tab – and tick on Do not split paragraph – Keep with next. My 50% percent problem will be solved. But I also want all the table should not allow to split across pages and columns and should not allow rows to split across rows and columns. How do I do it with macro.
Every macro uses Undo Manager to has only one step in Undo/Redo.
Change Paragraph Style:
Sub editStyle
dim oDoc as object, oStyles as object, oStyle as object, undoMgr as object
const cUndo="Edit Style"
oDoc=ThisComponent
undoMgr=oDoc.UndoManager
undoMgr.enterUndoContext(cUndo) 'only one step in Undo/Redo for all tables
rem paragraph style
oStyles=oDoc.StyleFamilies.getByName("ParagraphStyles") 'or: CharacterStyles etc. (see oDoc.StyleFamilies.ElementNames)
oStyle=oStyles.getByName("Text body")
with oStyle
.ParaKeepTogether=true
.ParaSplit=false
end with
undoMgr.leaveUndoContext(cUndo)
End Sub
Change tables in Writer:
Sub editTables
dim oDoc as object, oTable as object, oRow as object, undoMgr as object
const cUndo="Change Tables"
oDoc=ThisComponent
undoMgr=oDoc.UndoManager
undoMgr.enterUndoContext(cUndo) 'only one step in Undo/Redo for all tables
for each oTable in oDoc.TextTables
rem set "Allow table to split"
oTable.Split=false 'if Table split is false, then there isn't necessary to set "Allow row to break"
rem set "Allow row to break"
' for each oRow in oTable.Rows
' oRow.IsSplitAllowed=false 'it is necessary to set each row
' next
next
undoMgr.leaveUndoContext(cUndo)
End Sub
Small bonus: Change breaking lines to one Paragraph Style
Sub changeBreakLines
const cLine="Breaking Lines" 'name of new style for line breaks
dim oDoc as object, oStyles as object, oStyle as object, oBorder as new com.sun.star.table.BorderLine2, undoMgr as object
oDoc=ThisComponent
undoMgr=oDoc.UndoManager
undoMgr.enterUndoContext(cLine)
oStyles=oDoc.StyleFamilies.getByName("ParagraphStyles")
if NOT oStyles.hasByName(cLine) then 'style doesn't exist so create one
oStyle=oDoc.createInstance("com.sun.star.style.ParagraphStyle") 'new style
with oBorder
.Color=RGB(102, 102, 102)
.InnerLineWidth=26
.LineDistance=26
.LineStyle=4
.LineWidth=35
.OuterLineWidth=2
end with
with oStyle
.BottomBorder=oBorder
.ParaKeepTogether=true
.ParaBottomMargin=200
.ParaLeftMargin=500
.ParaRightMargin=500
.ParaTopMargin=500
.CharHeight=2
end with
oStyles.insertByName(cLine, oStyle)
end if
rem apply style to current breaking lines
dim oDesc as object, oFound as object, o as object
oDesc=oDoc.createSearchDescriptor
with oDesc
.SearchString="^-{3,}$"
.SearchRegularExpression=true
end with
oFound=oDoc.findAll(oDesc)
if NOT isNull(oFound) then
for each o in oFound
with o
.String="" 'no ------
.ParaStyleName=cLine 'set new style
end with
next
end if
undoMgr.leaveUndoContext(cLine)
End Sub
You are great
One change for Small bonus, I discovered better is to use TopBorder instead BottomBorder → to have breaking line really at the top of page and no 2px (=.CharHeight) under top of page .
with oStyle
.TopBorder=oBorder
.ParaBottomMargin=180
What is the purpose? Do you want to replace a data source with another one? There are easier ways to accomplish this task.
That dashed line is just to indicate from where we have to cut the page. The dashed line is appearing on top of the page which is not needed. Sorry for giving you trouble, but ```
.String=data(i)(0) 'Act Section
I suppose the .String=data(i)(0) 'Act Section means there is problem with the count of lines and sometimes it put text below “IN THE COURT OF” instead above. I add the test if the line contains “IN THE COURT OF”.
And also there is commented line '.String=data(i)(0) 'Act Section 'string from ODS and it puts string found in ODT, you can uncomment this line and comment next one to write string from ODS.
Updated part:
rem modify ODT
dim i&, s$, oStatusbar as object, oDesc as object, j&, iLen&, oFound as object, oVCur as object, undoMgr as object, sUndo$, sLine$, iLine%
oStatusbar=oDoc.CurrentController.StatusIndicator 'progressbar in Statusbar
oStatusbar.start("", ubound(data))
oVCur=oDoc.CurrentController.ViewCursor 'visible cursor
undoMgr=oDoc.UndoManager 'object for Undo/Redo
oDoc.lockControllers 'no screen rendering, faster
oDesc=oDoc.createSearchDescriptor
oDesc.SearchRegularExpression=true
for i=lbound(data) to ubound(data)
p=split(data(i)(0), "/")
iLen=Len(p(0)) : s=""
for j=1 to iLen 'adapt the string from ODS, for example SCC/304357/2012 -> S\.*C\.*C\.*\s*/\s*304357\s*/\s*2012
s=s & Mid(p(0), j, 1) & "\.*" '!!! regular expression supposes only dots among letters, no other marks (SCC -> S.C.C.)
next j
p(0)=s
oDesc.SearchString=join(p, "\s*/\s*")
oFound=oDoc.findFirst(oDesc)
if NOT isNull(oFound) then
sUndo=data(i)(0) & " " & data(i)(1)
undoMgr.enterUndoContext(sUndo) 'title for Undo
oDoc.CurrentController.Select(oFound)
with oVCur
.goToRange(oFound.Start, false)
.goToStartOfLine(false)
.String=" "
.collapseToStart
.CharWeight=com.sun.star.awt.FontWeight.BOLD 'set the bold format
.String=data(i)(1) & ")" 'Sr. No.
do 'find "IN THE COURT OF" in lines above the Sr. No.
.goUp(1, false)
.goToStartOfLine(false)
.goToEndOfLine(true)
sLine=oVCur.String
if InStr(sLine, "IN THE COURT OF")>0 then 'test if "IN THE COURT OF" is in current line
.goToStartOfLine(false)
oDoc.Text.insertControlCharacter(oVCur.End, com.sun.star.text.ControlCharacter.LINE_BREAK, false) 'add Shift+Enter at the top of Found
.goUp(1, false)
.CharWeight=com.sun.star.awt.FontWeight.BOLD
'.String=data(i)(0) 'Act Section 'string from ODS
.String=oFound.String 'string found in ODT
exit do
end if
iLine=iLine+1
loop while iLine<5 'maximum lines to try above Sr. No.
end with
undoMgr.leaveUndoContext(sUndo) 'more operations (Sr. No. + Act Section) as one operation for Undo
end if
if i MOD 10=0 then oStatusbar.setValue(i) 'update statusbar
next i
oVCur.goToStart(false)
if oDoc.hasControllersLocked then oDoc.unlockControllers 'screen rendering yes
oStatusbar.end : oStatusbar.reset
exit sub
1 Like
Still the Case No column is appearing where I expected Act Section column to appear.
Change one line in the part started rem get data from ODS
oRange=oSheet.getCellRangeByPosition(0, 1, oCur.RangeAddress.EndColumn, oCur.RangeAddress.EndRow) 'columns without 1st row
And .String= in main loop:
if InStr(sLine, "IN THE COURT OF")>0 then 'test if "IN THE COURT OF" is in current line
.String=data(i)(2) 'Act Section
1 Like
After this Act Section is appearing. Thank you so much for this. But above that the case number is also appearing which is not needed. Also if the dashed line is at the beginning of a page it should be removed.
For me, it is time to say STOP. I respect you don’t know programming, but you work with the system that is bigger and more exacting. In some cases it seems easily, but it isn’t so easy. I will not write next and next and next and next and next macros that move the Cursor to some positions to write some string. If you don’t understand to the movements of Cursor and insertings the strings from previous examples - and it seems you don’t understand to it - then next and next and next already same or similar requests are only degradation of my knowledge and help → to more and more and more chaos and swamp.
It seems you work with some systems that generates the “simple” text with “simple” tables, but there are some differences that need more and more and more conditions to “convert” data to some better design. I don’t know all combinations that could be occured and I will not write next and next and next and next same or similar operations to serve next and next and next and next exceptions etc. And I think there is big chance the system that generates the “raw data” will change the output and then there will be next and next and next and next fixing of previous macros - with the similar or same operations, but probably with next and next and next and next conditions for next and next and next and next exceptions.
Probably you need (or you will need) also some operations with strings like truncate ones, replace in ones etc., replace with regexp in ones etc. → but I suppose for next and next and next and next more and more strange and probably unnecessary “operations” to improve system that is made partially badly from the start. It isn’t good way to change raw data to direct formating, it could be exampled like: raw data are affair of 19th century, direct formatting of 20th century, any Styled formatting of 21th century. And spend a lot of time to get data from 19th century to the design of 20th century while 21th century is → it is useless work. And then much more complicated work will be to convert data from 20th century to 21th.
Yes, it isn’t so easy to make (high-)quality design completely based on Styles for your tables, and then make the conversion directly to full-styled design, but it isn’t impossible.
And do you write quality documentation for the macros you already collectioned? If yes, it must be really very hard work to describe all replacements and modifications for direct formatting only from your oDesc1, oDesc2, oDesc3, oDesc4, oDesc5, oDesc6, big serie of RDescrip etc. Of course with reasons why it is made as it is. To faciliate the understanding of used system to next people that will work with it. So I suppose there will be probably only talked “click here and run this and then run this and then run that and then run this and then … of course → run this! … oh sorry, run that… ooh sorry, some error, we must start from the start :-(”. And again and again.
And improvements of that systems are still the same → irritationed and exhaustioned. And I surely know it isn’t work for me.
It is complicated for me to translate well the Czech word nadšení. In Czech, it is mostly obvious term, but translation to English could be: enthusiasm, zeal, avidness or keenness or some next words. There was good example in dictionary for keenness → “My keenness for sports faded away.”, so I use the keenness. Sometimes I say: “Where is keenness, (there) will come burnout.” It is not some moralization, sermonizing or preachment, but the description of my experience, and I think you are in keenness from partial improvement of system, but the system that is partially bad from the start. I don’t wish you any burnout, but I think the burnout will come with next and next work on that system. And I surely know it isn’t for me.
1 Like
Ok, You helped me a lot. and the problem remaining of removing dashed line is not that much important. and I also can adjust the case number. thank you so much. More help is expected on different issues in furture.
I managed to delete the case number by following code. Thank you so much.
dim oDoc23 as object, oDesc23 as object
oDoc23=ThisComponent
oDesc23=oDoc23.createReplaceDescriptor
with oDesc23
.SearchString="[:print:]{1,100} / [:digit:]{1,100} / [:digit:]{1,4}\n"
.SearchRegularExpression=true 'by regexp
.ReplaceString=""
end with
oDoc23.replaceAll(oDesc23)
Small tips for multiReplacing, to eliminate the series of oDesc1, oDesc2, … oDescXXX, where XXX could be some sufficiently amazing number .
Sub multiReplace
dim oDoc as object, oDesc as object, aRepl(), arr()
aRepl=array( array("Find", "Replace"), array("aaa", "AAA"), array("bbb", "BBB") ) 'array with sub-arrays with: "Find", "Replace"
oDoc=ThisComponent
oDesc=oDoc.createReplaceDescriptor
with oDesc
.SearchRegularExpression=true 'by regexp
.SearchCaseSensitive=false 'no case-sensitive
end with
for each arr in aRepl 'all replacements in one loop
with oDesc
.SearchString=arr(0) 'Find
.ReplaceString=arr(1) 'Replace
end with
oDoc.replaceAll(oDesc)
next
End Sub
There can be also for example the place for regexp possibility in array(), with detection of ubound of this array to set regexp searching.
Sub multiReplaceRegexp
dim oDoc as object, oDesc as object, aRepl(), arr()
aRepl=array( array("ccc", "123"), array("a+", "A", true), array("b{2}", "@@", true) ) 'array: "Find", "Replace", byRegexp -> array( ... , ... , true) means Find&Replace by regexp
oDoc=ThisComponent
oDesc=oDoc.createReplaceDescriptor
for each arr in aRepl 'all replacements in one loop
with oDesc
.SearchString=arr(0) 'Find
.ReplaceString=arr(1) 'Replace
if ubound(arr)>1 then .SearchRegularExpression=arr(2) 'by Regexp
end with
oDoc.replaceAll(oDesc)
next
End Sub
But of course the well arranged way is to have the definitions in single lines.
aRepl=array( _
array("ccc", "123"), _
array("a+", "A", true), _
array("b{2}", "@@", true) _
)