Font chooser macro

When we need a fine font for specific text we need to write down the text and test the text by changing its font. Its time consuming. So, I make a small macro in microsoft word by VBA macro that prompt you to input the text and draw that text by assigning all available font from your system into different line. Moreover it input the corresponding font name at the starting point of each line.

Here is the macro code FYI:

Sub fontChooserByRazon()
' ' fontChooserByRazon Macro V:1.02 (razonklnbd [at] yahoo [dot] com) ' ' Dim txtStr As String, fntIdx As Long, fntNameLen As Long txtStr = InputBox("Input a text to show through various font of your computer", "Text for font chooser", "The quick brown fox jumps over the lazy dog.") fntIdx = 1 For fntIdx = 1 To Application.FontNames.Count
fntNameLen = Len(Application.FontNames(fntIdx)) Selection.TypeText Text:=Application.FontNames(fntIdx) & ": " & txtStr Selection.StartOf Unit:=wdParagraph Selection.StartIsActive = False Selection.MoveRight Unit:=wdCharacter, Count:=fntNameLen + 2 Selection.StartIsActive = True Selection.MoveEnd Unit:=wdParagraph Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend With Selection.Font
.Name = Application.FontNames(fntIdx) .Size = 12
End With Selection.MoveRight Selection.TypeText Chr(13)
Next fntIdx
End Sub

 

Sub selectedFontChooserByRazon()
' ' selectedFontChooserByRazon Macro V:1.05 (razonklnbd [at] yahoo [dot] com) ' ' Dim txtStr As String, fntIdx As Long, fntNameLen As Long, getInputFromUser As Boolean getInputFromUser = True txtStr = Trim(CStr(Selection.Text)) If Len(txtStr) > 2 Then
getInputFromUser = False Selection.StartOf Unit:=wdParagraph Selection.MoveEnd Unit:=wdParagraph Selection.MoveRight Selection.TypeText Chr(13) Selection.MoveLeft
End If If getInputFromUser Then
txtStr = InputBox("Input a text to show through various font of your computer", "Text for font chooser", "The quick brown fox jumps over the lazy dog.")
End If If Len(txtStr) > 2 Then
Selection.TypeText Chr(13) fntIdx = 1 For fntIdx = 1 To Application.FontNames.Count
With Selection.Font
.Name = "Verdana" .Size = 12
End With fntNameLen = Len(Application.FontNames(fntIdx)) Selection.TypeText Text:=Application.FontNames(fntIdx) & ": " & txtStr Selection.StartOf Unit:=wdParagraph Selection.StartIsActive = False Selection.MoveRight Unit:=wdCharacter, Count:=fntNameLen + 2 Selection.StartIsActive = True Selection.MoveEnd Unit:=wdParagraph 'Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend With Selection.Font
.Name = Application.FontNames(fntIdx) .Size = 12
End With Selection.MoveRight Selection.TypeText Chr(13)
Next fntIdx
End If
End Sub

Here is the screenshot:

This is my first VBA macro… If you have more suitable version please share with me…

Prepare USB printer for print through DOS based program like FoxPro

DOS based applications like FoxPro doesn’t detect an USB printer. One way of directing output to USB is by using “net use” at command line

We will use a little trick to work out. We fist share our printer with a share name within 8 digit name. Cause DOS didn’t support more then 8 characters. Then we will use above command. But we need to ensure that we will use text print only.

Now follow these instructions…

  • Share your USB printer and give its name at printer share name
  • Open the printer properties, select ADVANCE tab select “Print Processor” select TEXT and save the change
  • Now use “net use” command
    e.g. NET USE LPT1 \\<computer name>\<printer share name> /persistent:yes

At the command prompt type “DIR >PRN” this must give you print from USB printer, then try printing from your application.

That’s all folk. Now you can write a small batch file to active the printer every time before you go to FoxPro or any other DOS program