none
Determine language of font RRS feed

  • Question

  • Hello all experts,

    Recently I've come across several macrosto print samples of all fonts installed on local machine, they loop thru all installed fonts and type a sample text for each one, the problem is that if the font doesn't support english (the language of the sample text) boxes show-up instead of the letters, us there a way to detect what language each font suports? If its possible then for a different language font I can have it type text in a supported language.

    Here is one of the macros:

    Sub FontSamples()
    
      ' Samples all fonts installed
      ' Macro written 31 March 2006 by John McGhie
     
      Const SampleText As String = "the quick brown fox jumps over the lazy dog." & _
          " THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG 0 1 2 3 4 5 6 7 8 9"
    
     
    
      Dim i As Long
    
      ' Make our own array because FontNames is FUBARed
      Dim AllFonts() As String
      Dim StyDoc As Document
     
      Set StyDoc = Application.Documents.Add
    
       ' Resize the array the way we want it (in case the user has an Option Base set)
      ReDim AllFonts( 1 To FontNames.Count)
    
      ' Load the array one by one from FontNames
      For i = 1 To FontNames.Count
        AllFonts(i) = FontNames(i)
      Next i
    
      ' Use the WordBasic sort because VBA doesn't have one!!
      WordBasic.SortArray AllFonts$()
     
      ' Adjust the styles we want to use in the document we just created
    
      With StyDoc.Styles
        With .Item(wdStyleHeading1)
          .Font.Color = wdColorBlue
          .ParagraphFormat.PageBreakBefore = False
        End With
        With .Item(wdStyleBodyText)
          .Font.Size = 36
          .Font.Color = wdColorAutomatic
        End With
      End With
    
     
      ' Add a TOC so we can list the styles and find them later
    
      With StyDoc.TablesOfContents
        .Add Range:=Selection.Range, RightAlignPageNumbers:= _
            True , UseHeadingStyles:= True , UpperHeadingLevel:= 1 , _
            LowerHeadingLevel:= 1 , IncludePageNumbers:= True , AddedStyles:= ""
        .Item( 1 ).TabLeader = wdTabLeaderDots
        .Format = wdIndexIndent
      End With
    
       ' there's a bug in FontNames collection, in WD2003 we can't
       ' use For Each ... Next, it errors due to a type mismatch
     
      For i = 1 To UBound (AllFonts)
        With Selection
          .Style = wdStyleHeading1
          .TypeText Text:=AllFonts(i)
          .TypeParagraph
          .Style = wdStyleBodyText
          .Font.Name = AllFonts(i)
          .TypeText Text:=SampleText
          .TypeParagraph
          .TypeParagraph
        End With
      Next i
    
      StyDoc.TablesOfContents( 1 ).Update
    
      Selection.HomeKey Unit:=wdStory, Extend:=wdMove 
    
    End Sub

    Here are links to someother macros to accomplish the same:

    http://www.brainbell.com/tutorials/ms-office/Word/Print_Samples_Of_Each_Font_Installed_On_Your_PC.htm#

    http://support.microsoft.com/default.aspx?scid=kb;en-us;209205

    http://www.techrepublic.com/article/configure-it-quick-re-create-words-font-sampler-macro-with-these-handy-refinements/5034597

    http://word.mvps.org/faqs/formatting/fontsamplegenerator.htm


    • Edited by moishy Monday, February 20, 2012 7:07 AM
    Monday, February 20, 2012 5:33 AM

All replies