word vba fonts

Topic

New Reply

Is there a way to determine with a macro what fonts have been used in a Word document?

Reply | Quote

Replies

What version of Word are you using?

Reply | Quote

word 97 / word 2000

Reply | Quote

Word 97 had a supplemental macro in Macros8.dot called SuperDocStatistics that you might be interested in. I believe this will run on Word 2000, but Macros9.dot doesn’t have this specific macro.

This macro can document all of the Fonts, Styles, Sections, Hyperlinks, Tables, and Fields used in a document, including the page number and section. (Fonts and Styles only the page number and section of the first occurrence is documented)

You can view the information on screen or you can generate a report for any specific piece. This will include the page numbers and section.

To utilize this macro, locate Macros8.dot in the OfficeMacros folder or on the installation CD.

Either place a shortcut to it in your Startup folder so it will automatically load as a global template or go to Tools/Templates and Add-Ins and manually add it.

I add it manually since I don’t always utilize the supplemental macros. Once it has been added, then all you need to do is to return to Tools/Templates and Add-Ins and tick the reference to the template.

If you don’t see a Macros toolbar, right-click any toolbar and turn it on. There you’ll find the SuperDocStatistics macro along with a few others that may come in handy some day.
~~~~~~~~~
Cheers!

Reply | Quote

BAM,

Thanks, I never knew that was there, it seems quite helpful. One thing to note though is it runs up against one of the limitations I found when writing my macro, it misses hidden text, text boxes, and header / footer text. I guess it really depends on where you need the font info from.

Reply | Quote

Hi James,

I have found the SuperDocStatistics macro to be very helpful in the past. Especially when you have an “at a glance” review of Styles, Sections, and Tables info.

It was included in Word 6.0 – I don’t know why they did away with it in Word 2000. But I kept a copy of all of the Macros?.dot to use in later versions.

The majority of them converted from WordBasic to VBA OK. Some needed a couple of modifications here and there, the only one that doesn’t work is the MindBender game from Macro6.dot

Anyway, yes that does seem to be the case. The macro is only looking in the text layer. If anything, at least you know they are MS limitations too!

Here is what I found:
– If you go to View/Header and Footer and run the macro it will pick up the fonts.
– If the text box is a frame it will pick up the fonts. This is logical since the frame is in the text layer rather than floating. Most Word features will not pick up floating objects.
– If Hidden text is displayed it will pick up the fonts.

You could modify your macro and include the Header/Footer view, show Hidden text, and change each text box to a frame.

However the latter could prove to be difficult since it could easily throw off the positions of the text boxes when they are changed back.
~~~~~~~~~~~
Cheers!

Reply | Quote

The following is a crack at it (done with Word 2000 but should work the same with Word 97).

The main problem is that different fonts can be applied to individual characters; therefore the macro has to examine every character in the entire document in turn – and this makes the macro run Extremely Slowly (more than 2 minutes per page!)

Another interesting aspect of this is, once a font name has been added to the list, some sort of comparison needs to be done to ensure that it doesn’t get added twice (this was done using the InStr function).

The solution below works, but isn’t very functional due to how slowly it runs.
It would be nice if there is a quicker way to do this; couldn’t think of one offhand though.

Sub ListAllFonts()
'Gary Frieder  February 2001
'Purpose:   List all fonts in use in a document
'Warnings:  This code examines every character in the document,
'           therefore it runs EXTREMELY SLOWLY!!
'           (approx. 2+ minutes per page!)
            
Dim n As Long
Dim strOneFont As String
Dim strFontList As String
Dim objChars As Characters
Dim objView As View
Dim bHidden As Boolean

Set objView = ActiveWindow.View
bHidden = objView.ShowHiddenText
'show hidden text if currently hidden
objView.ShowHiddenText = True

Set objChars = ActiveDocument.Characters

For n = 1 To objChars.Count
    strOneFont = objChars(n).Font.Name
    If n = 1 Then 'add first font to strFontList
        strFontList = strFontList & strOneFont & vbCr
    Else ' after first font, only add if no match:
        If InStr(strFontList, strOneFont) = 0 Then
            strFontList = strFontList & strOneFont & vbCr
        End If
    End If
Next n

'restore show hidden setting:
objView.ShowHiddenText = bHidden

MsgBox strFontList
End Sub

Reply | Quote

Here is my crack at it. Kind of a different approach, not sure which is better, or if mine is flawed; I welcome any comments.

Sub ListFontsUsedinDoc()
Dim strFonts As String

Set objView = ActiveWindow.View
bHidden = objView.ShowHiddenText 'show hidden text if currently hidden
objView.ShowHiddenText = True

For Each aStory In ActiveDocument.StoryRanges
    For Each afont In FontNames
        With aStory.Find
                .ClearFormatting
                .Font.Name = afont
                .Wrap = wdFindContinue
                .Forward = True
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                If .Execute = True Then
                        'This fills a string with the font list that
                        'is then displayed in the message box, but
                        'you could do whatever you need to with the
                        'font names here
                        strFonts = strFonts & vbCrLf & afont
                End If
        End With
    Next afont
Next aStory

'restore show hidden setting:
objView.ShowHiddenText = bHidden

MsgBox "Fonts in Document:" & vbCrLf & strFonts
End Sub

Gary,
I just pretty blatantly plagiarized your hidden text code, hope you do not mind.

Reply | Quote

Hi James,

Great idea! – much faster than examining every character – (only about 50 times faster!)

My version didn’t even consider content in other story ranges such as headers/footers, but since yours does, you’d want to add a test to make sure you don’t get duplicates in the list.

James,
Just an added comment to your added comment: if you want to, you can plagiarize the InStr test too!

Gary

Reply | Quote

Thanks Gary, I did.

Sub ListFontsUsedinDoc()
'James Brooks  February 2001
'Credit: Gary Frieder for some plagiarized code snippets
'Purpose:   List all fonts in use in a document

Dim strFonts As String

Set objView = ActiveWindow.View
bHidden = objView.ShowHiddenText 'show hidden text if currently hidden
objView.ShowHiddenText = True

 For Each aStory In ActiveDocument.StoryRanges
    For Each aFont In FontNames
       With aStory.Find
                .ClearFormatting
                .Font.Name = aFont
                .Wrap = wdFindContinue
                .Forward = True
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                If .Execute = True Then
                        'This fills a string with the font list that
                        'is then displayed in the message box, but
                        'you could do whatever you need to with the
                        'font names here
                        If InStr(strFonts, aFont) = 0 Then
                        strFonts = strFonts & vbCrLf & aFont
                        End If
                        
                End If
        End With
    Next aFont
Next aStory

'restore show hidden setting:
objView.ShowHiddenText = bHidden

MsgBox "Fonts in Document:" & vbCrLf & strFonts

End Sub

Reply | Quote

Hi James,

It’s not plagiarism, it’s appropriation – everything on this Lounge is fair game for reuse. I’m going to return the favor by using your code any chance I get, it’s a handy one.

By the way you noticed that the first InStr test in my code wasn’t really necessary; it was left over from an earlier attempt (where I was testing for Instr(etc.) 0 rather than = 0, then forgot to take it out.

I’ve just recalled where a similar approach to yours saved the day; we had a thread on the old Lounge several months ago regarding the difficulty in identifying whether a style exists in a document – suppose you want to apply a style: it’s going to cause an error if that style is not available in that document. But there’s no direct way to test for it, no Style.Exists property. Everything we tried to do to test for it would cause a runtime error.

The solution came some time later in some code that Chris Greaves posted: you run a Find on the style name. (This is best set up as a little boolean function to which you pass the style name). That one solved a big problem for me at the time; I should have remembered it!

Gary

Reply | Quote

thank you very much

Reply | Quote

When I tried this, I came up with the following errors:

bHidden not defined (Boolean?)
aStory not defined (Range?)
aFont not defined (Word.Font?)
For Each aFont In FontNames came up with Object Required.

By that time, I had decided to quit.

Reply | Quote

Hi Al,

Don’t give up!
Simple solution: just go to the top of your code module and delete the line that says “Option Explicit”. James’s code did not declare all variables (as it should have done – naughty naughty ), and this will trigger the messages you’re getting, if Option Explicit is set.

The best approach is to use Option Explicit and always declare all variables, but in this case, deleting it should provide a quick fix.

Gary

Reply | Quote

But is it going to stop the Object Required error? (See previous post)

Reply | Quote

Answered my own question. Yes it does. Weird!

Reply | Quote

Yeah, that one’s a bit of a mystery to me too – will have to take a closer look at that…

Reply | Quote

Here is a revised version of the code. It works with Option Explicit at the beginning of the module.

Sub ListFontsUsedinDoc()
'James Brooks  February 2001
'Credit: Gary Frieder for some plagiarized code snippets
'Purpose:   List all fonts in use in a document
'---------------------------------------------------------------
'Revised by JustCallMeAl, May 2001 to include functionality with
'   Option Explicit declared at the beginning of the module
'---------------------------------------------------------------
 
    Dim strFonts As String
    Dim bHidden As Boolean
    Dim aStory As Range
    Dim aFont As Variant
    Dim objView As Object
     
    Set objView = ActiveWindow.View
    bHidden = objView.ShowHiddenText 'show hidden text if currently hidden
    objView.ShowHiddenText = True
    
     For Each aStory In ActiveDocument.StoryRanges
        For Each aFont In Application.FontNames
           With aStory.Find
                    .ClearFormatting
                    .Font.Name = aFont
                    .Wrap = wdFindContinue
                    .Forward = True
                    .Format = True
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                    If .Execute = True Then
                            'This fills a string with the font list that
                            'is then displayed in the message box, but
                            'you could do whatever you need to with the
                            'font names here
                            If InStr(strFonts, aFont) = 0 Then
                            strFonts = strFonts & vbCrLf & aFont
                            End If
                            
                    End If
            End With
        Next aFont
    Next aStory
    
    'restore show hidden setting:
    objView.ShowHiddenText = bHidden
    
    MsgBox "Fonts in Document:" & vbCrLf & strFonts
 
End Sub

Also, file attached.

Reply | Quote

That’s great, Al.

Now, the only thing left to do is (edit the post) to make these couple of minor tweaks:

Dim aFont As Font
Dim objView As View

Gary

Reply | Quote

Dim aFont as Font does not work (Word 2000).

It took me a long time to figure that one out. I finally used “Dim aFont” and it worked. Then tried “Dim aFont as String” and got an error stating that it was a variant.

Dim objView as View does work, however.

Reply | Quote

Thanks, Al – I stand corrected .

Reply | Quote

An interesting phenomenon has occurred with this code, suing Word 97, SR 2.

If I choose a font, i.e., WP MultinationalA Roman, and type a character (specifically to make a “C” with a specific accent over the top, not available in non-Unicode New Times Roman), and run the macro, it picks up that WP MultinationalA Roman font was used.

However, if I insert the same character via Insert, Symbol, WP MultinationalA Roman font, and run the macro, it does not recognize that WP MultinationalA Roman font was used as a basis to create that character.

Strange, huh?

Reply | Quote

>Strange, huh?

Word will also tell you that the character you inserted from WP MultinationalA Roman (or any “decorative” font like “Symbol”, “Wingdings” etc.) is a ASCII 40 “(“. For reasons like these, I run a macro that replaces those characters by true characters from the “decorative” font.

The macro in the appended file will do that (and more). The basic idea of using the built-in dialog “wdDialogInsertSymbol” I got from http://www.mvps.org/word (Dave Rado).

I just added some new code to this macro a few days ago: Since I often import unicode text from other sources (multilingual XML-files), I often have “unknown character”-boxes (squares) in my text.
I have found a dirty hack to find those boxes (That hack might only work in Word 2000):
If you select such a box and call “Insert/Symbol”, the dialog will not be able to display the character, so I try to take advantage of that fact. Unfortunately, I have to use SendKeys ( ) and to display the dialog for a short time.

You can test the macro by inserting some asian characters with a big unicode font such as “Arial Unicode MS”, cutting and pasting special as “unformatted text”, and selecting one of the boxes.

Sub TestChar()

	Dim myCharNum as Long 
	Dim dlgInsertSymbol As Dialog
	Set dlgInsertSymbol = Dialogs(wdDialogInsertSymbol)
	myCharNum = AscW(Selection.Text)
	dlgInsertSymbol.CharNum = myCharNum
	dlgInsertSymbol.Unicode = True
	' dirt hack
	SendKeys "{RIGHT}{Left}"
	dlgInsertSymbol.Display 1
	If dlgInsertSymbol.CharNum  myCharNum Then
		MsgBox "Character is not displayed", vbOKOnly + vbCritical, "Result:"
	End If
End Sub

Reply | Quote

If you assume that the document you are examining was not created to torture-test your code, you might take a more optimistic approach by working with larger ranges until you find a problem. For example, check the font name for each paragraph until you get vbNullString, indicating more than one font in that paragraph. Then drill down to the sentence level, then to the characters. True, this could miss the spaces…..

I haven’t tested this code, but this is the general idea:

Sub FontTester()
Dim aPara As Paragraph, mySentences As Sentences
Dim intSent As Integer, myCharacters As Characters
For Each aPara In ActiveDocument.Paragraphs
    If aPara.Range.Font.Name  vbNullString Then
        BuildFontList(aPara.Range.Font.Name)
    Else
        Set mySentences = aPara.Range.Sentences
        For intSent = 1 To mySentences.Count
            If mySentences(intSent).Font.Name  vbNullString Then
                BuildFontList(mySentences(intSent).Font.Name)
            Else
                Set myCharacters = mySentences(intCount).Characters
                'parse characters
            End If
        Next
    End If
Next
End Sub

Reply | Quote

Hi J.,

Thanks for posting this code. I think James B.’s method is going to be the one to go with since it goes right at the answer, but I think your approach is better than the one I posted also.

Your comment is perceptive: the first thing I did was to come up with a sample document that presented the most difficult challenges imaginable: hidden text, fonts applied to spaces etc.

But in real world documents problems don’t always present themselves that consistently – more of a ‘lumpy universe’ – so your approach is food for thought in how to get past the non-problem stuff efficiently and save the processing attention for the problem parts.
(I like the use of vbNullString too.)

Regards,
Gary

Reply | Quote