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
   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.TextColor.RGB = RGB(50,50,50)
objFont.Underline = wdUnderline.wdUnderlineSingle
objFont.UnderlineColor = wdColor.wdColorAutomatic


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

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

Getting the current selection

Dim objRange As Range 
Set objRange = Application.Selection.Range

Turn off extension mode

Selection.ExtendMode = False 

This refers to the whole document

objRange = ActiveDocument.Range() 


Documents.Add Template:="Normal", NewTemplate:=False 
ActiveDocument.Close SaveChanges := wdDoNotSaveChanges

Copy the entire document

Selection.HomeKey Unit:=wdUnits.wdStory 

Looping until the end of the document

Do Until ActiveDocument.Bookmarks("\Sel") = ActiveDocument.Bookmarks("\EndOfDoc") 

Is the Insertion point at the end of a document

If Selection.Type = wdSelectionType.wdSelectionIP And _ 
   Selection.End = ActiveDocument.Content.End - 1 Then

End If

Selection.StartOf unit:=wdParagraph, Extend:=wdMove
Selection.SetRange Start:=Selection.Paragraphs(1).Range.Start, End:=Selection.Paragraphs(1).Range.End

© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited TopPrevNext