Font Effect such as Bold, Italic for Character Style

[vbaNOOB]

Hi All,

I can set font style for char style.
Is there a way to check if the font style is applied by it's own char style,
or from the original text?

Many Thanks

 

[Pesach Shelnitz]

Hi,

Try this.

Sub FontFormatDiff()
Dim styleName As Variant
Dim msg As String
Dim diffFound As Boolean

styleName = Selection.Style
msg = "Differences from the applied style were found in:" _
& vbCrLf & vbCrLf
With ActiveDocument.Styles(styleName)
If Selection.Font.AllCaps <> .Font.AllCaps Then
diffFound = True
msg = msg & "AllCaps" & vbCrLf
End If
If Selection.Font.Bold <> .Font.Bold Then
diffFound = True
msg = msg & "Bold" & vbCrLf
End If
If Selection.Font.Color <> .Font.Color Then
diffFound = True
msg = msg & "Color" & vbCrLf
End If
If Selection.Font.DoubleStrikeThrough <> .Font.DoubleStrikeThrough
Then
diffFound = True
msg = msg & "DoubleStrikeThrough" & vbCrLf
End If
If Selection.Font.Emboss <> .Font.Emboss Then
diffFound = True
msg = msg & "Emboss" & vbCrLf
End If
If Selection.Font.Engrave <> .Font.Engrave Then
diffFound = True
msg = msg & "Engrave" & vbCrLf
End If
If Selection.Font.Italic <> .Font.Italic Then
diffFound = True
msg = msg & "Italic" & vbCrLf
End If
If Selection.Font.Name <> .Font.Name Then
diffFound = True
msg = msg & "Name" & vbCrLf
End If
If Selection.Font.Outline <> .Font.Outline Then
diffFound = True
msg = msg & "Outline" & vbCrLf
End If
If Selection.Font.Shadow <> .Font.Shadow Then
diffFound = True
msg = msg & "Shadow" & vbCrLf
End If
If Selection.Font.Size <> .Font.Size Then
diffFound = True
msg = msg & "Size" & vbCrLf
End If
If Selection.Font.SmallCaps <> .Font.SmallCaps Then
diffFound = True
msg = msg & "SmallCaps" & vbCrLf
End If
If Selection.Font.StrikeThrough <> .Font.StrikeThrough Then
diffFound = True
msg = msg & "StrikeThrough" & vbCrLf
End If
If Selection.Font.Subscript <> .Font.Subscript Then
diffFound = True
msg = msg & "Subscript" & vbCrLf
End If
If Selection.Font.Superscript <> .Font.Superscript Then
diffFound = True
msg = msg & "Superscript" & vbCrLf
End If
If Selection.Font.Underline <> .Font.Underline Then
diffFound = True
msg = msg & "Underline" & vbCrLf
End If
End With
If diffFound = True Then
MsgBox msg
Else
MsgBox "No differences from the applied style were found."
End If
End Sub

If there are more properties that I overlooked, you should be able to add
the code for them.