Solved

UnavailableFonts - VBA

Posted on 2004-08-23
12
710 Views
Last Modified: 2013-12-03
Hi

I would like to display all the substituted fonts thru a msgbox.

I tried Application.Dialogs.Item(wdDialogFontSubstitution).unavailablefont. But it gives me the name of the first substituted font, but not the others, i.e. if there are 4 unavailable fonts, the abovesaid function returns only the first unavailable font. How can I get the list of all unavailable fonts?

Thanx
Srik
0
Comment
Question by:vi_srikanth
  • 4
  • 3
  • 3
  • +1
12 Comments
 
LVL 12

Expert Comment

by:fulscher
ID: 11879445
One solution could be to make a list of all installed fonts and compare it to the list of fonts in the document.

The list of all fonts is contained in Application.FontNames

The list of fonts contained in the document is appearently not this easy to retrieve. http://www.tribbs.co.uk/showtip.php?myID=29&start=6 suggest to iterate through each character and check its font - this is certainly feasible, but obviously extremly slow.

Any other ideas?
0
 
LVL 4

Author Comment

by:vi_srikanth
ID: 11889118
Thats how I have right now. But, I want to do that thru wdDialogFontSubstitution. Is there any way?
0
 
LVL 22

Expert Comment

by:Dreamboat
ID: 11889822
Try to get something out of this...

Private Sub btnFonts_Click()
  main
End Sub
Public Sub main()
  Dim sMsg As String
  sMsg = GetFonts(ThisDocument)
  MsgBox "The fonts in this document are:" & vbNewLine & vbNewLine & sMsg
  MsgBox "The following fonts are used in this document," & vbNewLine & "but are not installed on this PC:" & vbNewLine & CompareFonts(sMsg)
End Sub

Private Function GetFonts(ByVal oDocument As Document) As String
  Dim oParagraph As Paragraph
  Dim i As Integer
  Dim oWord As Words
  Dim sFontType As String
  Dim sMsg As String
  For Each oParagraph In oDocument.Paragraphs
    For i = 1 To oParagraph.Range.Characters.Count
      sFontType = oParagraph.Range.Characters(i).Font.Name
      If InStr(1, sMsg, sFontType) = 0 Then
        sMsg = sMsg & sFontType & vbNewLine
      End If
    Next
  Next
  GetFonts = sMsg
End Function

Private Function CompareFonts(ByVal oFonts As String) As String
Dim vFont As Variant
Dim sMsg As String
Dim xFont
Dim i As Long
Dim allFonts As String
For Each vFont In FontNames
allFonts = allFonts & vbNewLine & vFont
Next vFont
xFont = Split(oFonts, vbNewLine)
For i = 0 To UBound(xFont)
If InStr(allFonts, xFont(i)) = 0 Then
sMsg = sMsg & vbNewLine & xFont(i)
End If
Next i
CompareFonts = sMsg
End Function
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 12

Expert Comment

by:fulscher
ID: 11889931
vi_srikanth,

it looks like the only shortcut would be to use the use SelectCurrentFont method instead of selecting each individual character as shown in the sample above from Dreamboat.

I have not yet found a way to extract the elements from the list box. An option might be to display the dialog and use some clever API programming to extract the list elements; however, this would require some external programs (i.e., not Word VBA).

Still looking into it, but I'm not very confident...

0
 
LVL 4

Author Comment

by:vi_srikanth
ID: 11899407
Hi Dreamboat,

As I've said earlier,  I want to do that thru wdDialogFontSubstitution. The Application.Dialogs.Item(wdDialogFontSubstitution).unavailablefont displays only the first font, but, how can i get the other unavailable fonts?

Hi  fulscher,

When u've got the solution pls. let me know.

Thnx
Srik
0
 
LVL 22

Expert Comment

by:Dreamboat
ID: 11899446
What do you mean, the first available font?

When I run that code, it tells me ALL the fonts that are unavailable on the PC, not just the *first*.

I created a file.
I set two fonts: Century Times and Univers

BOTH fonts showed as unavailable.
Isn't that what you want?
0
 
LVL 22

Expert Comment

by:Dreamboat
ID: 11899476
No one has discussed version here...

And, I've finally got the code loaded with a sample file:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=137
0
 
LVL 12

Expert Comment

by:fulscher
ID: 11899765
Sorry, no news yet. I'm still not sure whether this can be solved using the wdDialogFontSubstitution dialog - MS obviously did not intend you to make use of the info provided there :-(

Jan
0
 
LVL 4

Author Comment

by:vi_srikanth
ID: 11901350
> When I run that code, it tells me ALL the fonts that are unavailable on the PC, not just the *first*.

I want to collect the names of the unavailable fonts thru wdDialogFontSubstitution. At present I have a code like what u've posted, but, I would like to use the Word's FontSubstitution information itself. More than that, I want to know the name of the substituted font. I use Word 2000.
0
 
LVL 22

Expert Comment

by:Dreamboat
ID: 12202938
Refund and PAQ. I don't think we ever figured out what the asker really wanted.
0
 
LVL 1

Accepted Solution

by:
Computer101 earned 0 total points
ID: 12231977
PAQed, with points refunded (250)

Computer101
E-E Admin
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

If you work with Word a lot, you probably use styles. If you use styles a lot, you've probably balled your fist more often than not when working with the ribbon. In Word 2007/2010, one of the things that I find missing when using styles is a quic…
I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
This video shows the viewer how to set up and create Footnotes in their document. Click on the References tab: Select "Insert Footnote": Type in desired text:
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question