VBA Code
Obtains a collection of all the font names that are currently available
Dim objFontName As FontNames
objFontNames = Application.FontNames
objFontNames = Application.PortraitFontNames
objFontNames = Application.LandscapeFontNames
Note the loop variable must be either an object variable or a variable of type Variant
It cannot be a string variable, as would otherwise be appropriate here.
Dim objFontName As Variant
For Each objFontName In Application.FontNames
Selection.InsertAfter objFontName.Name & vbCrLf
Next objFontName
Dim objFont as Font
Set objFont = ActiveWindow.Selection.Font
wdUndefined and wdToggle
This value cannot be set as a value but might be returned when a Range contains several different types of formatting.
Lets imagine that the first paragraph in a document contains both bold and not bold text.
This code will change all the text to bold when there is a mixture of bold and not bold and toggle the bold when it either all bold or all not bold.
Dim objFont as Font
Set objFont = ActiveDocument.Paragraphs(1).Range.Font
If (objFont.Bold = wdConstants.wdUndefined) Then
objFont.Bold = True
Else
objFont.Bold = wdConstants.wdToggle
End If
Dim objFont As Font
Set objFont = New Font
objFont.Name = "Arial"
objFont.Bold = -1 (True) / 0 (False)
objFont.Italic = True / False
objFont.Size = 12
objFont.Color = wdConstants.wdColorDarkYellow
objFont.Underline = wdUnderline.wdUnderlineSingle
objFont.UnderlineColor = wdColor.wdColorAutomatic
Effects
Dim objFont As Font
Set objFont = New Font
With objFont
.StrikeThrough = True | False | wdConstants.wdToggle
.DoubleStrikeThrough = True | False
'Setting the Superscript property to True automatically sets the Subscript property to False, and vice versa.
.Superscript = True | False
.Subscript = True | False
.Shadow = True | False
.Outline = True | False
.Emboss = True | False
.Engrave = True | False
.SmallCaps = True
.AllCaps = True | False
.Hidden = True | False
End With
objFont.Spacing = 0
objFont.Scaling = 100
objFont.Position = 0
objFont.Kerning = 0
objFont.Animation = wdAnimation.wdAnimationNone
ActiveDocument.Words(1).case = wdCharacterCase.wdUpperCase
ActiveDocument.Paragraphs(1).Range.Font = objFont
ActiveWindow.Selection.Font = objFont
ActiveWindow.Selection.Font.ColorIndex = wdColorIndex.wdAuto
ActiveWindow.Selection.Font.ColorIndex = wdColorIndex.wdRed
Difference between Text and FormattedText
objRange.Text = the objects unformatted text
sText = objRange.Text
objRange.FormattedText - returns a range object that represents the text and the formatting
objRange = obAnotherRange.FormattedText
The FormattedText property has a special use and that is to transfer text and formatting from one range to another
Dim objRange As Range
objRange = ActiveDocument.Words(2)
Detect if the first character in the selection is alphanumeric
If Selection.Characters(1) Like "[a-zA-Z0-9] Then
Call Msgbox("Alphanumeric")
End If
Detect if the first character in the selection is alphanumeric
If Selection.Characters(1) Like "[!a-zA-Z0-9] Then
Call Msgbox("NOT Alphanumeric")
End If
Display a list of all Fonts currently installed
Public Sub CreateTable
Dim objDocument As Document
Dim sSampleText As String
Dim sFontName As String
Dim objRange As Range
Dim objStartRange As Range
Dim lcount As Long
Set objDocument = Documents.Add
sSampleText = Chr(147) & _
"ABCDEFGHIJKLMNOPQRSTUVWYZ" & Chr(148) & ", " & Chr(147) & _
"abcdefghijklmnopqrstuvwxyz" & Chr(148) & ", " & Chr(147) & _
"The quick brown fox jumps over the lazy dog" & Chr(148) & ", " & Chr(147) & _
"(;,.:£$?!)" & Chr(146)
System.Cursor = wdCursorType.wdCursorWait
With objDocument
For lcount = 1 To Application.FontNames.Count
sFontName = Application.FontNames(lcount)
StatusBar = "Adding " & sFontName
Set objRange = .Range
With objRange
.Collapse wdCollapseDirection.wdCollapseEnd
.Font.Reset
.InsertAfter sFontName & " - " & SampleText
End With
Set objRange = .Range
With objRange
.Collapse wdCollapseDirection.wdCollapseEnd
.InsertAfter sSampleText
Set objStartRange = .Duplicate
objStartRange.End = .End
objStartRange.Font.Name = sFontName
.InsertAfter vbCrLf
End With
Next lcount
.Range.Sort FieldNumber:="Paragraphs"
.Paragraphs(1).Range.Text = "Font" & vbTab & "Sample" & vbCr
.Range.ConvertToTable Format:=wdTableFormat.wdTableFormatClassic1, _
AutoFit:=True
With .Tables(1)
.Rows.AllowBreakAcrossPages = False
.Rows(1).HeadingFormat = True
End With
End With
System.Cursor = wdCursorType.wdCursorNormal
End Sub
© 2019 Better Solutions Limited. All Rights Reserved. © 2019 Better Solutions Limited TopPrev