I am using Ubuntu 22.04 and LibreOffice 24.2.0.3. I have a document typed in font Kruti Dev 055, Kruti Dev 011 and so on (Kruti Dev XXX) . There are nearabout hundreds of fonts in the family of Kruti Dev. I have created a find and replace macro which is presently finding text typed in any font and replacing it. I just want the macro should find all text typed in Kruti Dev XXX and replace it with Lohit Devnagari.
Use the Styles instead of the direct formatting method. Then you will able to change all of same formatted properties in one place: in the applied Sytle.
(And never format cell containing constant strings, partially:
| This method is so unmanageable |.
Set the constants cFont and cNewFont to your fonts. And also change the property CharFontName to CharFontNameAsian or CharFontNameComplex in two lines with condition, there is the comment '!!! - I donât know what is used for Lohit Devanagari etc.
Sub replaceFonts
dim oDoc as object, oSheet as object, oCur as object, oRange as object, i&, j&, data(), oCell as object, oEnum as object, o as object, oEnum2 as object, o2 as object
const cFont="Linux" 'part of old font name
const cNewFont="Liberation Serif" 'new font
oDoc=ThisComponent
oSheet=oDoc.CurrentController.ActiveSheet
rem detect used area
oCur=oSheet.createCursor
oCur.goToEndOfUsedArea(false)
oRange=oSheet.getCellRangeByPosition(0, 0, oCur.RangeAddress.EndColumn, oCur.RangeAddress.EndRow)
data=oRange.getDataArray
rem check the cells
for i=0 to ubound(data) 'rows
for j=0 to ubound(data(i)) 'columns
if data(i)(j)<>"" then
oCell=oSheet.getCellByPosition(j, i)
oCur=oCell.createTextCursor 'text cursor in cell
oEnum=oCur.Text.createEnumeration
o=oEnum.nextElement
oEnum2=o.createEnumeration
do while oEnum2.hasMoreElements
o2=oEnum2.nextElement
rem test the font name
if inStr(o2.CharFontName, cFont)>0 then '!!! CharFontName / CharFontNameAsian / CharFontNameComplex
o2.CharFontName=cNewFont '!!! CharFontName / CharFontNameAsian / CharFontNameComplex
end if
loop
end if
next j
next i
End Sub
1 Like
This macro is working in calc. But in writer it is showing error in the following line.
oSheet=oDoc.CurrentController.ActiveSheet
Now my further requirement is I had created a find and replace macro and I want that macro to find text typed only in Kruti Dev XXX font and replace the text and change its font to Lohit Devnagari.
I overlooked the label writer, so I wrote macro only for calc :-).
For Writer it can be more complicated if there are the text tables or frames in document. Can you upload example ODT?
Hello Aniruddha,
test this macro, it is lightcore version with repeated F&R for every font that contains the constant cOldFont in its name. So if you will have 100 fonts âKruti Dev XXXâ (Kruti Dev 001, Kruti Dev 002 ⌠Krut Devi 100), it will do 100x F&R in document.
Firstly set the constants at the start of macro.
Theoretically it should be possible to create hardcore version â unzip the ODT and do F&R in inner XMLs and then zip back to ODT, but it could be really unsafe to edit the inner XMLs handly.
Sub multireplaceFontsInWriter 'it takes all fonts in Wroter, separate only the fonts that have the cOldFont in name, and repeatedly Find&Replace these old fonts to cNewFont
on local error goto bug
rem !!! set these constants !!!
const cOldFont="Linux" 'part of name of font to replace
const cNewFont="DejaVu Sans" 'new font
const cType="CharFontName" ' or "CharFontNameAsian" or "CharFontNameComplex"
const cUndo="Replace fonts" 'string for undo manager
dim oDoc as object, oDesc as object, oFound as object, oFontDesc as object, oWindow as object, oFonts as object, undoMgr as object
dim searchAttr(0) as new com.sun.star.beans.PropertyValue, replAttr(0) as new com.sun.star.beans.PropertyValue
oDoc=ThisComponent
oWindow=oDoc.CurrentController.Frame.ContainerWindow
oFonts=oWindow.FontDescriptors
on local error resume next 'there could be some unexpected problem with collection
dim i%, s$, col as new collection
for i=0 to ubound(oFonts)
s=oFonts(i).Name 'font name
rem is old name the part of found font name?
if InStr(s, cOldFont)>0 then col.add(s, s) 'add the name of found font to collection
next i
on local error goto bug
dim aFonts(0 to col.Count-1)
for i=0 to col.Count-1 'from collection to array
aFonts(i)=col(i+1)
next i
if ubound(aFonts)=-1 then exit sub
oDoc.lockControllers 'no rendering of screen during replacing
undoMgr=oDoc.UndoManager
undoMgr.enterUndoContext(cUndo)
rem search document for all old fonts
oDesc=oDoc.createReplaceDescriptor
searchAttr(0).Name=cType
replAttr(0).Name=cType
replAttr(0).Value=cNewFont
oDesc.setReplaceAttributes(replAttr)
for i=lbound(aFonts) to ubound(aFonts)
searchAttr(0).Value=aFonts(i)
oDesc.setSearchAttributes(searchAttr)
oDoc.replaceAll(oDesc)
next i
undoMgr.leaveUndoContext(cUndo)
oDoc.unlockControllers
exit sub
bug:
if oDoc.hasControllersLocked then oDoc.unlockControllers
msgbox(Error & chr(13) & "Line: " & Erl & chr(13) & Err & chr(13), 16, "bug")
End Sub
1 Like
2nd version, it checks only the fonts used in document (because there could be fonts in document that arenât installed in OS)
Sub multireplaceFontsInDocument 'it takes all fonts from Document, separate only the fonts that have the cOldFont in name, and repeatedly Find&Replace these old fonts to cNewFont
on local error goto bug
rem !!! set these constants !!!
const cOldFont="Linux" 'part of name of font to replace
const cNewFont="DejaVu Sans" 'new font
const cType="CharFontName" ' or "CharFontNameAsian" or "CharFontNameComplex"
const cUndo="Replace fonts" 'string for undo manager
dim oDoc as object, oDesc as object, oFound as object, undoMgr as object, o as object, i%
dim searchAttr(0) as new com.sun.star.beans.PropertyValue, replAttr(0) as new com.sun.star.beans.PropertyValue
oDoc=ThisComponent
rem detect the fonts used in document, source: https://extensions.openoffice.org/en/project/testfonts
searchAttr(0).Name=cType
oDesc=oDoc.createSearchDescriptor()
with oDesc
.SearchAll=true
.ValueSearch=false ' true=search for the property; false=search only the occurence of property
.SearchStyles=false 'find attributes of text including the ones set via Style
.SetSearchAttributes(searchAttr)
end with
oFound=oDoc.findAll(oDesc)
if oFound.Count=0 then exit sub
rem list of used fonts
dim aFonts(oFound.Count-1)
for i=0 to oFound.Count-1
o=oFound.getByIndex(i)
aFonts(i)=o.getPropertyValue(cType)
next i
oDoc.lockControllers 'no rendering of screen during replacing
undoMgr=oDoc.UndoManager
undoMgr.enterUndoContext(cUndo)
rem search document for all old fonts
oDesc=oDoc.createReplaceDescriptor
searchAttr(0).Name=cType
replAttr(0).Name=cType
replAttr(0).Value=cNewFont
oDesc.setReplaceAttributes(replAttr)
for i=lbound(aFonts) to ubound(aFonts)
searchAttr(0).Value=aFonts(i)
oDesc.setSearchAttributes(searchAttr)
oDoc.replaceAll(oDesc)
next i
undoMgr.leaveUndoContext(cUndo)
oDoc.unlockControllers
exit sub
bug:
if oDoc.hasControllersLocked then oDoc.unlockControllers
msgbox(Error & chr(13) & "Line: " & Erl & chr(13) & Err & chr(13), 16, "bug")
End Sub
1 Like
Both the codes work fine. Now further task is to find a particular text typed in any Kruti Dev font and replace it with another text in Lohit Devnagari Font.
I suppose it will be faster only one searching with testing the fontName for each found string.
Sub findAndReplaceWithFonts 'F&R the strings fonted as cOldFont
on local error goto bug
const cUndo="F&R in fonts" 'string for undo manager
dim oDoc as object, oDesc as object, oFound as object, undoMgr as object, o as object, sSearch$, sRepl$
rem !!! set !!!
const cOldFont="linux" 'the part of name of font to replace
const cNewFont="DejaVu Sans" 'new font
const cType="CharFontName" ' or "CharFontNameAsian" or "CharFontNameComplex"
sSearch="ice" 'string to search
sRepl="PIE" 'replacement
rem search the text
oDoc=ThisComponent
oDesc=oDoc.createSearchDescriptor()
oDesc.SearchString=sSearch 'string to find
oFound=oDoc.findAll(oDesc)
if oFound.Count=0 then exit sub 'nothing is found
oDoc.lockControllers 'no rendering of screen during replacing
undoMgr=oDoc.UndoManager
undoMgr.enterUndoContext(cUndo)
rem test found for fontName and replace
for each o in oFound
if InStr(o.getPropertyValue(cType), cOldFont)>0 then 'there is only one fontName in found text that includes cOldFont
with o
.setPropertyValue(cType, cNewFont)
.String=sRepl
end with
end if
next
undoMgr.leaveUndoContext(cUndo)
oDoc.unlockControllers
exit sub
bug:
if oDoc.hasControllersLocked then oDoc.unlockControllers
msgbox(Error & chr(13) & "Line: " & Erl & chr(13) & Err & chr(13), 16, "bug")
End Sub
What if I have to search hundreds of text strings and replace it. And also I want to change the language of the replaced text to Marathi
For hundreds replacements in one document is becoming the progressbar. There is also oLocaleComplex to set complex language (but I tested it with Arabic).
Sub FindReplComplexFonts 'F&R with Complex font
on local error goto bug
const cUndo="F&R in fonts" 'string for undo manager
dim oDoc as object, oDesc as object, oFound as object, undoMgr as object, o as object, sSearch$, sRepl$, oLocaleComplex as new com.sun.star.lang.Locale, _
oStatusbar as object, iStep&
const cType="CharFontNameComplex"
rem !!! set !!!
const cOldFont="Amiri" 'the part of complex font name to replace
const cNewFont="Lohit Devanagari" 'new font
with oLocaleComplex 'language: Marathi
.Country="IN"
.Language="mr"
end with
sSearch="ŮŮ" 'string to search
sRepl="ظظ" 'replacement
rem search the text
oDoc=ThisComponent
oDesc=oDoc.createSearchDescriptor()
oDesc.SearchString=sSearch 'string to find
oFound=oDoc.findAll(oDesc)
if oFound.Count=0 then exit sub 'nothing is found
oDoc.lockControllers 'no rendering of screen during replacing
undoMgr=oDoc.UndoManager
undoMgr.enterUndoContext(cUndo)
oStatusbar=oDoc.CurrentController.StatusIndicator 'show statusbar
oStatusbar.Start("", oFound.Count)
oStatusbar.Value=1
rem test found for fontName and replace
for each o in oFound
if InStr(o.getPropertyValue(cType), cOldFont)>0 then 'there is only one fontName in found text that includes cOldFont
with o
.setPropertyValue(cType, cNewFont)
.CharLocaleComplex=oLocaleComplex
.String=sRepl
end with
end if
iStep=iStep+1 'count for statusbar
if iStep MOD 10=0 then oStatusbar.Value=iStep 'update statusbar after 10 founds
next
oStatusbar.end
oStatusbar.reset
undoMgr.leaveUndoContext(cUndo)
oDoc.unlockControllers
exit sub
bug:
if oDoc.hasControllersLocked then oDoc.unlockControllers
msgbox(Error & chr(13) & "Line: " & Erl & chr(13) & Err & chr(13), 16, "bug")
End Sub
But if you will need the replacement in more files, are you able to copy all files to one directory?
I have recorded a macro then by using mail merge I placed args1043. I have to find every letter of Kruti Dev font and replace it with another letter of Lohit Devnagari Font. Similarly, I have to find some combination of letters of Kruti Dev font and replace it with some combination of letters of Lohit Devnagari font. Therefore, I need the code for multiple find and replace.
Kruti Dev to Unicode Macro Code.odt (176.5 KB)
It solves my another problem. Many times we get such documents in which some Kruti Dev font was used but it is not installed out system. This macro can change the font of that particular text to the font which is installed in out system.
This macro solves my another problem. Many times some text used to be typed in Kruti Dev 011 and some texts in Kruti Dev 035 and we have to change the font of all the text to Kruti Dev 055 without disturbing the English texts.