|
|
Thread Tools | Display Modes |
#1
|
||||
|
||||
Check the font attached to a template's "Normal" style and report if it's not installed
Hi folks.
I found this useful code on Adam Dimech's Coding Blog which checks to see if the User has the required template font installed on their computer and reports with a Message Box. However, I'd like VBA to check for whatever font has been set in the "Normal" style when creating a new, or opening an existing, document based on the template, rather than specifying a font name in the code. Quote:
|
#2
|
||||
|
||||
ActiveDocument.Styles(wdStyleNormal).Font.Name
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
||||
|
||||
You might also be interested in:
Code:
Sub ListInstalledFonts() Application.ScreenUpdating = False Dim ListFont As Variant With ActiveDocument.Characters For Each ListFont In FontNames With .Last .Font.Name = "Arial" .Font.Size = 12 .Text = ListFont & Chr(11) End With With .Last .Font.Name = ListFont .InsertAfter "ABCDEFGHIJKLMNOPQRSTUVWXYZ ~!@#$%^&*()_+|<>?:{}" & Chr(11) & _ "abcdefghijklmnopqrstuvwxyz `1234567890-=\,.;'[]" & vbCr End With With .Last .Font.Name = "Arial" .InsertAfter vbCr End With Next ListFont End With Application.ScreenUpdating = True End Sub Code:
Sub TestDocFonts() Application.ScreenUpdating = False Dim StrFnt As Variant, StrFnts As String, StrInFnt As String, StrNoFnt As String, Fnt As Font For Each StrFnt In FontNames StrFnts = StrFnts & "'" & StrFnt Next StrFnts = StrFnts & "'" With ActiveDocument.Range With .Find .ClearFormatting .Format = True .Forward = True .Wrap = wdFindContinue .MatchWildcards = True .Text = "[!^13]{1,}" With .Replacement .ClearFormatting .Text = "^&" .Font.Hidden = True End With .Execute Replace:=wdReplaceAll .Text = "?" .Font.Hidden = True .Execute End With Do While .Find.Found Set Fnt = .Font With Fnt If InStr(StrFnts, "'" & .Name & "'") > 0 Then StrInFnt = StrInFnt & vbCr & .Name Else StrNoFnt = StrNoFnt & vbCr & .Name End If End With With .Duplicate.Find .Font.Hidden = True .Replacement.Font.Hidden = False .Font.Name = Fnt.Name .Execute Replace:=wdReplaceAll .Font.Name = Fnt.Name & Fnt.NameAscii .Execute Replace:=wdReplaceAll .Font.Name = "" .Font.NameAscii = Fnt.NameAscii .Execute Replace:=wdReplaceAll End With .Find.Execute DoEvents Loop End With Application.ScreenUpdating = True MsgBox "The following fonts were found in the document, and on the system:" & StrInFnt MsgBox "The following fonts were found in the document, but not on the system:" & StrNoFnt End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
||||
|
||||
Firstly, huge apologies to Andrew and Paul for not thanking them for the replies. Work got the better of me and I missed the reply notifications. The above is useful, many thanks.
I'd like to take it a step further for another area of the VBA. To illustrate, please see the adapted code below with commenting. Quote:
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
"Changes have been made that affect the global template, Normal.dotm. ..." | DBlomgren | Word | 11 | 12-18-2017 12:54 PM |
Setting Font Color and Style "permanently" | wings1080 | Word | 5 | 12-19-2014 08:44 AM |
Documents hung up, Word won't close due to "Changes made..to global template Normal.dotm" | pagskg | Word | 2 | 07-23-2014 12:54 PM |
Style doesn't enforce "Do not check spelling" | Jennifer Murphy | Word | 7 | 01-30-2012 12:51 AM |
"Table of content" based on "Normal Style" behavior!!!! | Jamal NUMAN | Word | 4 | 07-08-2011 04:12 AM |