Solved

UnavailableFonts - VBA

Posted on 2004-08-23
12
723 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
[Live Webinar] The Cloud Skills Gap

As Cloud technologies come of age, business leaders grapple with the impact it has on their team's skills and the gap associated with the use of a cloud platform.

Join experts from 451 Research and Concerto Cloud Services on July 27th where we will examine fact and fiction.

 
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Nice table. Huge mess. Maybe this was something you created way back before you figured out tabs or a document you received from someone else. Either way, using the spacebar to separate the columns resulted in a mess. Trying to convert text to t…
Shortcuts in Word Just the other day I had a training for Microsoft and they wanted me to show how well the new Windows and Office behaved on a touch device, which by the way is great, but it was only then that I realized that using keyboard shortc…
This video shows and describes the main difference between both orientations in Microsoft Word. Viewers will understand when to use each orientation and how to get the most out of them.
This Micro Tutorial well show you how to find and replace special characters in Microsoft Word. This is similar to carriage returns to convert columns of values from Microsoft Excel into comma separated lists.

617 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