Style.InUse property (Word)

True if the specified style is a built-in style that has been modified or applied in the document or a new style that has been created in the document. Read-only Boolean.

Syntax

expression. InUse

expression An expression that returns a 'Style' object.

Remarks

The InUse property doesn't necessarily indicate whether the style is currently applied to any text in the document. For instance, if text that's been formatted with a style is deleted, the InUse property of the style remains True. For built-in styles that have never been used in the document, this property returns False.

Example

This example displays a message box that lists the names of all the styles that are currently being used in the active document.

Dim docActive As Document 
Dim strMessage As String 
Dim styleLoop As Style 
 
Set docActive = ActiveDocument 
 
strMessage = "Styles in use:" & vbCr 
 
For Each styleLoop In docActive.Styles 
 If styleLoop.InUse = True Then 
 With docActive 
 .Content.Find 
 .ClearFormatting 
 .Text = "" 
 .Style = styleLoop 
 .Execute Format:=True 
 If .Found = True Then 
 strMessage = strMessage & styleLoop.Name & vbCr 
 End If 
 End With 
 End If 
Next styleLoop 
 
MsgBox strMessage

See also

Style Object

Support and feedback

Have questions or feedback about Office VBA or this documentation? Please see Office VBA support and feedback for guidance about the ways you can receive support and provide feedback.