List fonts used in a document, search by font.
Help!I cannot find a way to list, by name, of the fonts used (past tense) in a document.Like in the document properties: where the word and character count is.
Example: The author used Arial, Arial Condensed and OCR A in her document. I would like to see a list of three font names. If I have (or don't have) those fonts is outside the scope of this request.
Simply smashing the styles of a document and then restylng by hand is not working so well for me. Most of the documents used manual formatting instead of styles too!
Second: I can search and replace text if it had a font applied to it, but I cannot specify the font to search on. ANY font will be match and changed to the 'replace' style. Any solution?
Thanks!
John Fields
[771 byte] By [
jfields] at [2007-11-26 6:29:07]
# 2
Interesting request and a bit of a programing challenge but here is what I have come up with. Try it on some of the documents that you need to deal with and let me know how it does.
Sub FontsUsed 'Version 1 John Vigor 4/25/06
'List fonts used in Writer document. Appears to work in normal text,
'Sections, normal Tables, and Frames. Will currently crash on a Table
'within a Table.
oDoc = ThisComponent
Dim fonts as Integer: Dim aFonts(1)
oTC = oDoc.Text.createTextCursor
oTC.goRight(1,true) : CurrentFont = oTC.charFontName
fonts = fonts + 1 : aFonts(fonts) = CurrentFont
REM Do "normal" text.
partEnum = oDoc.Text.createEnumeration
PartEnumerator(partEnum,CurrentFont,fonts,aFonts())
REM Do Frames.
oFrames = oDoc.getTextFrames
If oFrames.Count > 0 then
fonts = fonts + 1 : ReDim Preserve aFonts(fonts)
aFonts(fonts) = "NEW FONTS, IF ANY, FOUND IN FRAMES:"
For I = 0 to oFrames.Count - 1
thisFrame = oFrames.getByIndex(I)
partEnum = thisFrame.createEnumeration
PartEnumerator(partEnum,CurrentFont,fonts,aFonts())
Next
EndIf
REM Prepare list.
For I = 1 to fonts
s = s & aFonts(I) & Chr(10)
Next
iAns = MsgBox(s,4,"FONTS FOUND. Create font list document?")
If iAns = 7 then
End
Else
NewDoc = StarDesktop.loadComponentFromURL("private:factory/swriter"," blank",O,Array())
oVC = NewDoc.CurrentController.getViewCursor
oVC.String = s : oVC.collapseToEnd
EndIf
End Sub
Sub PartEnumerator(partEnum,CurrentFont,fonts,aFonts())
While partEnum.hasMoreElements
thisElement = partEnum.nextElement
If thisElement.supportsService("com.sun.star.text.Paragraph") then
portionEnum = thisElement.createEnumeration
PortionEnumerator(portionEnum,CurrentFont,fonts,aFonts())
ElseIf thisElement. supportsService ("com.sun.star.text.TextTab le") then
Cols = thisElement.getColumns.Count - 1
Rows = thisElement.getRows.Count - 1
For C = 0 to Cols
For R = 0 to Rows
thisCell = thisElement.getCellByPosition(C,R)
cellEnum = thisCell.createEnumeration
While cellEnum.hasMoreElements
thisPara = cellEnum.nextElement
portionEnum = thisPara.createEnumeration
PortionEnumerator(portionEnum,CurrentFont,fonts,aFonts())
Wend
Next
Next
EndIf
Wend
End Sub
Sub PortionEnumerator(portionEnum,CurrentFont,fonts,aFonts())
Dim found as Boolean
While portionEnum.hasMoreElements
thisPortion = portionEnum.nextElement
thisFont = thisPortion.charFontName
If thisFont <> CurrentFont then
For I = 1 to fonts
If aFonts(I) = thisFont then found = true: Exit For
Next
If found then
CurrentFont = thisFont : found = false Else
fonts = fonts + 1 : ReDim Preserve aFonts(fonts)
aFonts(fonts) = thisFont : CurrentFont = thisFont
EndIF
EndIf
Wend
End Sub
JohnV at 2007-7-6 14:24:21 >
