Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 11-10-2021, 02:28 PM
Catluvr Catluvr is offline Need Help Modifying Code to print all fonts Windows 7 64bit Need Help Modifying Code to print all fonts Office 2016
Novice
Need Help Modifying Code to print all fonts
 
Join Date: Jul 2018
Posts: 7
Catluvr is on a distinguished road
Default Need Help Modifying Code to print all fonts

The last time I was on this forum site, I received some excellent Excel VBA help.

I am cross posting this because the other forum I used doesn't seem to have much traffic. I hope that's okay!

I have been using VBA with Access for years. I've dabbled just a bit in VBA with Excel. The only VBA I've used in Word has been code I've found on-line and used as is. This time, I want to modify the code I found on-line. I've tried a few things with no luck. I'm quite sure you experts will look at what I want to do and know the correct syntax in three seconds!

What I want to do is create a listing of all the fonts available on my computer along with sample text. I found code that does exactly that. Whoo Hoo!



However, I would like to change the spacing and perhaps change the font size.

Here is what I get with the un-modified code:

The first font name <-- this uses the Heading 2 style​

The sample text {in the first font} <-- this uses the Normal style
The second font name

The sample text {in the second font}
The third font name​

The sample text {in the third font}

When I look at the above, my brain automatically assumes that the font name closest to the sample text is the font used for the sample text. What I would like to see instead is:

The first font name <-- this uses the Heading 2 style​
The sample text {in the first font} <-- this uses the Normal style

The second font name
The sample text {in the second font}

The third font name​
The sample text {in the third font}

I've tried adding vbCrLf or vbCr in various places with no luck. I think maybe it has to do with the style properties, but I'm not sure.

So, I also tried modifying the Heading 2 and Normal style ... although I will say I couldn't modify either to get what I wanted, just some very minor spacing changes. I did add a vbCr after the title that's added to the document. Also, the new document created used the default styles anyway. I don't want to change the default styles across the board.

Here is the code I'm using:


Code:
  Sub List_All_Fonts()
      'Code copied from BrainBell.com  November 2021
      'https://www.brainbell.com/tutorials/ms-office/Word/Print_Samples_Of_Each_Font_Installed_On_Your_PC.htm
      
      'Lists all the fonts available to Word with the current printer driver
      
      Dim strFont As Variant
      Dim strText As String
      strText = InputBox(Prompt:= _
          "Type the sample text you want to use in the font listing:", _
          Title:="List All Fonts", _
          Default:="The five boxing wizards jump quickly.")
      If strText = "" Then Exit Sub
      Documents.Add
      For Each strFont In FontNames
          Selection.Font.Reset
          Selection.TypeText strFont & "parahere"
          Selection.Font.Name = strFont
          Selection.TypeText strText & vbCr
      Next
      ActiveDocument.Content.Select
      Selection.Sort FieldNumber:="Paragraphs", _
          SortFieldtype:=wdSortFieldAlphanumeric
      With Selection.Find
          .ClearFormatting
          .MatchCase = False
          .MatchAllWordForms = False
          .MatchWholeWord = False
          .MatchSoundsLike = False
          .MatchWildcards = False
          .Forward = True
          .Wrap = wdFindContinue
          .Text = "parahere"
          .Replacement.Text = "parahere^p"
          .Execute Replace:=wdReplaceAll
          .Text = "parahere"
          .Replacement.Style = "Heading 2"
          .Execute Replace:=wdReplaceAll
          .Replacement.ClearFormatting
          .Replacement.Text = ""
          .Execute Replace:=wdReplaceAll
          .Text = ""
      End With
      Selection.Collapse Direction:=wdCollapseStart
      Selection.Paragraphs(1).Style = "Heading 1"
      Selection.TypeText "List of Fonts Available to Word" & vbCr  'I added the & vbCr in order to add a space after this heading
      MsgBox "The macro has created a list showing the fonts currently " _
         & "available to Word." & vbCr & vbCr & _
        "Please save this document if you want to keep it.", _
        vbOKOnly + vbInformation, "List All Fonts Macro"
    End Sub
Where and what should I add/change to get the spacing I want?

Thank you ever so much!


Susie
Kansas
Reply With Quote
  #2  
Old 11-10-2021, 07:17 PM
Guessed's Avatar
Guessed Guessed is offline Need Help Modifying Code to print all fonts Windows 10 Need Help Modifying Code to print all fonts Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

I prefer to load this type of information to a table so it can be sorted and formatted more easily. Try this variation on the code.
Code:
Sub InsertAllFontSamples()
  'Inserts samples of all installed fonts into the current file
  Dim strFont As Variant, sText As String, oTbl As Table, aRng As Range, oRow As Row
  sText = "The quick brown fox jumped over the lazy dog. 12345 67890"
  Application.ScreenUpdating = False
    Set aRng = Selection.Range
    Set oTbl = ActiveDocument.Tables.Add(Range:=aRng, numrows:=1, numcolumns:=2)
    oTbl.cell(1, 1).Range.Text = "Font"
    oTbl.cell(1, 2).Range.Text = "Sample"
    oTbl.Range.Style = wdStyleNormal
    oTbl.Columns(1).PreferredWidthType = wdPreferredWidthPercent
    oTbl.Columns(1).PreferredWidth = 30
    oTbl.Columns(2).PreferredWidth = 70
    For Each strFont In Application.FontNames
      Set oRow = oTbl.Rows.Add
      oRow.Cells(1).Range.Text = strFont
      oRow.Cells(2).Range.Text = sText
      oRow.Cells(2).Range.Font.Name = strFont
    Next strFont
    oTbl.ApplyStyleHeadingRows = True
    oTbl.SortAscending
  Application.ScreenUpdating = True
  MsgBox "Macro finished!"
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #3  
Old 12-01-2021, 12:14 PM
Catluvr Catluvr is offline Need Help Modifying Code to print all fonts Windows 7 64bit Need Help Modifying Code to print all fonts Office 2016
Novice
Need Help Modifying Code to print all fonts
 
Join Date: Jul 2018
Posts: 7
Catluvr is on a distinguished road
Default

Andrew,

THANK YOU! This is perfect!

Susie
Kansas, USA
Reply With Quote
Reply

Tags
list of fonts, spacing issues, vba

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Cannot print specific fonts Head Word 4 06-23-2018 06:03 PM
Need Help Modifying Code to print all fonts Need help with modifying a replacing font VBA code- similar task but subtle change kissingfrogs2003 Word VBA 3 08-30-2016 11:42 AM
Code to Print page 2 only Bursal Word VBA 1 05-05-2016 09:58 PM
How to print a line of text with all available fonts in the same document electrocad Word VBA 1 10-17-2015 04:53 AM
vba Code to Print Spreadsheet to PDF OTPM Excel Programming 3 05-25-2011 08:22 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:46 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft