[Solved] How to Find/Replace Fonts?

[humbug]

Hi all,
This may be a very simple answer but I've searched all over with no luck finding it. I am writing a macro to change old Word95 documents that contain ascii Greek font characters into Unicode (using the Greek and Coptic and Greek Extended areas of unicode). I did this already going character by character through the file but this did not access and change the characters in the footnotes.

So I'm now trying to do this task through Find/Replace in OOoBasic but I'm stumped about how to specify both the Find and the Replace font names. Below is sample code for where I am now with just two characters specified for the test (&HF061 = Greek alpha in the old ascii font which is &H03B1 in Unicode, etc.). The aFindReplace array holds the search for character followed by the replace character.

Thanks in advance for your help!
Steve

Code: Select all

Sub TEST01

Dim oDoc As Object
Dim aFindReplace, FandR
Dim i As Long

	oDoc = ThisComponent
	FandR = oDoc.createReplaceDescriptor
	i = 0

Gosub FillArray

	With FandR
		.SearchCaseSensitive = True
		.SearchRegularExpression = True
rem Do I set Find Font Name here somehow???
    End With

    While i <= uBound(aFindReplace)
		FandR.setSearchString(aFindReplace(i))		' i is set to find string
		FandR.setReplaceString(aFindReplace(i+1))	' Set i to replace string
		i = i + 2
rem Do I set Replace Font Name here or earlier somehow???
		oDoc.ReplaceAll(FandR)
    Wend

MsgBox ("Conversion completed!",64,"All Done")

Exit Sub


FillArray:

aFindReplace = Array(Chr(&HF061), Chr(&H03B1), Chr(&HF0B7), Chr(&H1F71))

Return

End Sub

[humbug]

OK, I've found the solution by adapting from various examples on various forums. If anyone is interested, I can post some generic code that shows how....

Best,
Steve

[FJCC]

Yes, I'd like to see the code.

[humbug]

OK. But just a qualification. I found out all this through looking at examples primarily and borrowed code from various sources. I am a beginner at OOoBasic and I am not a programmer. I did do a lot of (amateur) programming decades ago (assembly and basic), but that was before object-oriented langauges came into being.... So there may be a much better way to do this.

Just a short explanation of the code below. The font I'm converting is called "Greek NT" (a font I made around 1995). This is a symbol font, so the characters are coded in both Word and Openoffice when imported with an extra &HF000 value (i.e., "space" is &HF020, alpha ("a") is &HF061 etc.). This makes them easy to find. I'm changing Greek NT characters to unicode "FreeSerif"--an excellent open source font for lots of languages. (Greek NT alpha is &HF061 whereas in unicode it's &H03B1). The array below in the code is shortened for this example.

The key to find/replace a font is to use the com....beans.PropertyValue service (see the two Dim statements and the search setup section.

NOTE: Be sure to have a character to convert with this code. If you leave the out the .setSearchString and/or .setReplaceString or if you set these strings to "" you will crash everything and have to reboot (I found out the hard way several times).

Best,
Steve

Code: Select all

Sub GNTConverter

Dim oDoc As Object
Dim aReplace
Dim aFindReplace
Dim oReplace
Dim gntFont As String
Dim newGreek As String
Dim newFont As String
Dim i As Long
Dim c As Long
Dim findChr As String
Rem
Rem This is needed for Find/Replace font:
Dim searchVal(0) As New com.sun.star.beans.PropertyValue
Dim replaceVal(0) As New com.sun.star.beans.PropertyValue

	oDoc = ThisComponent
	oReplace = oDoc.createReplaceDescriptor
	gntFont = "Greek NT;Symbol"					' Old ANSI symbol font to change
	newGreek = "FreeSerif"						' new Unicode

Gosub FillArray

Rem
Rem Set up Find/Replace for Greek NT font to new Unicode font
Rem

	With oReplace
		.SearchCaseSensitive = True
		.SearchRegularExpression = True
		.searchStyles = True
		.searchAll = True
	End With
    
	searchVal(0).Name = "CharFontName"     ' This is needed for the SetSearchAttributes
	searchVal(0).Value = gntFont

	replaceVal(0).Name = "CharFontName"    ' This is needed for the SetReplaceAttributes
	replaceVal(0).Value = newGreek

	oReplace.SetSearchAttributes(searchVal())
	oReplace.SetReplaceAttributes(replaceVal())

Rem
Rem This is the main Find/Replace code block for Greek NT to Unicode
Rem
	
	c = 32	' Start with space character
	i = 0
   	
	While i <= uBound(aReplace)
	    	findChr = Chr(c + &HF000)				' Greek NT has &HF000 added to characters for symbol font
		oReplace.setSearchString(findChr)
		oReplace.setReplaceString(Chr(aReplace(i)))		' i is index into array to replace old chr with new

		oDoc.ReplaceAll(oReplace)

		c = c + 1
		i = i + 1
	Wend

MsgBox ("Conversion completed!",64,"All Done")

Exit Sub


FillArrays:

aReplace = Array(&H20, &H1FCE, &H22, &H1FCF, &H1FDE, &H1FDD, &H26, &H27, &H28, &H29)

[green3gg]

To Find/Replace Fonts in LibreOffice writer is possible in the Edit > Find & Replace dialog.

Edit > Find & Replace,
Clear the Search text,
Click Other Options,
Uncheck any Attribute selected, . .

Now . .
Click in the empty Search test,
Format > Font tab, select the Font name to replace.
Click Find All and it should show info and highlight any matching text.

Then . .
Click in the empty Replace with,
Format > Font tab, select the Font name to substitute.
Click Replace All and it should do the replace.