#1
|
|||
|
|||
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 Thank you ever so much! Susie Kansas |
#2
|
||||
|
||||
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 |
#3
|
|||
|
|||
Andrew,
THANK YOU! This is perfect! Susie Kansas, USA |
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 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 |