HIGHLIGHT Non-standard Styles macro? (2)

[adam.mjbarnes]

I am trying to make a macro that highlights any style that is not in my
list (styles and formatting) menu, I only have about 20 styles, I am
very new to macros, and using word 2003, I need it to work in word 2000
as well, is this possible.

I have tried ti follow this

http://groups.google.co.uk/group/mi...o+to+check+styles&rnum=2#6b4131438789f8aa"


with not much luck, I changed this bit to my style names:

Private Function FillOfficialStyleList() As Integer
' This routine could be changed to read the list
' of names from a text file, which could be easily
' updated without needing to change the code.
OfficialStyleList(0) = "Ahead"
OfficialStyleList(1) = "Bhead"
OfficialStyleList(2) = "Chead"
OfficialStyleList(3) = "MainText"
OfficialStyleList(4) = "bold"
OfficialStyleList(5) = "italic"
OfficialStyleList(6) = "Header"
OfficialStyleList(7) = "Footer"
FillOfficialStyleList = 7
End Function

But it highlighted all the text including my styles?

Any help would be fantastic!

 

[Jean-Guy Marcil]

(e-mail address removed) was telling us:
(e-mail address removed) nous racontait que :

I am trying to make a macro that highlights any style that is not in
my list (styles and formatting) menu, I only have about 20 styles, I
am very new to macros, and using word 2003, I need it to work in word
2000 as well, is this possible.

I have tried ti follow this

http://groups.google.co.uk/group/mi...o+to+check+styles&rnum=2#6b4131438789f8aa"


with not much luck, I changed this bit to my style names:

Private Function FillOfficialStyleList() As Integer
' This routine could be changed to read the list
' of names from a text file, which could be easily
' updated without needing to change the code.
OfficialStyleList(0) = "Ahead"
OfficialStyleList(1) = "Bhead"
OfficialStyleList(2) = "Chead"
OfficialStyleList(3) = "MainText"
OfficialStyleList(4) = "bold"
OfficialStyleList(5) = "italic"
OfficialStyleList(6) = "Header"
OfficialStyleList(7) = "Footer"
FillOfficialStyleList = 7
End Function

But it highlighted all the text including my styles?

Any help would be fantastic!

There is a catch in that some styles may not be in the document as such, but
still be in use because they kind of apply to the whole document.

In the main sub (HighlightUnofficialStyles), change:

If idx > nOfficialStyles Then
FindAndHighlight (oStyle.NameLocal)
End If

to

If oStyle.NameLocal <> "Default Paragraph Font" _
And oStyle.NameLocal <> "No List" Then
If idx > nOfficialStyles Then
FindAndHighlight (oStyle.NameLocal)
End If
End If


--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[adam.mjbarnes]

Hi Jean,

And thanks that is working very very well in word 2003, but not in word
XP? I get an error

Run-time error '5834':
Item with specified name dose not exist.

it happens when it gets to .Style = StyleName (Ln 102)

This is all my code, I am very new to this, so I could be missing
somthing very simple?

Can you have a quick look? or will it only work in 2003.

Thanks again for the help!




Dim OfficialStyleList(100) As String

Sub HighlightUnofficialStyles()
Dim oStyle As Style
Dim nOfficialStyles As Integer ' last filled element of array
Dim idx As Integer

System.Cursor = wdCursorWait
Application.ScreenUpdating = False

nOfficialStyles = FillOfficialStyleList
For Each oStyle In ActiveDocument.Styles
If oStyle.InUse Then
' If oStyle.InUse = True, the style *may* be used
' somewhere in the document. It may also mean that
' the style was used at one time but isn't used now.

For idx = 0 To nOfficialStyles
If oStyle.NameLocal = OfficialStyleList(idx) Then
' It's official, so stop looking
Exit For
End If
Next idx

' If we get here and the style wasn't in the
' official list, idx will be nOfficialStyles + 1
If oStyle.NameLocal <> "Default Paragraph Font" _
And oStyle.NameLocal <> "No List" Then
If idx > nOfficialStyles Then
FindAndHighlight (oStyle.NameLocal)
End If
End If
End If
Next oStyle

System.Cursor = wdCursorNormal
Application.ScreenUpdating = True

End Sub

Private Function FillOfficialStyleList() As Integer
' This routine could be changed to read the list
' of names from a text file, which could be easily
' updated without needing to change the code.
OfficialStyleList(0) = "Default Paragraph Font"
OfficialStyleList(1) = "Ahead"
OfficialStyleList(2) = "Bhead"
OfficialStyleList(3) = "Chead"
OfficialStyleList(4) = "Dhead"
OfficialStyleList(5) = "MainText"
OfficialStyleList(6) = "MainText1indent"
OfficialStyleList(7) = "MainText2indent"
OfficialStyleList(8) = "MainText3indent"
OfficialStyleList(9) = "QuoteText"
OfficialStyleList(10) = "TableHeader"
OfficialStyleList(11) = "TableText"
OfficialStyleList(12) = "bullet"
OfficialStyleList(13) = "Bold"
OfficialStyleList(14) = "BoldItalic"
OfficialStyleList(15) = "BoldUnderItalic"
OfficialStyleList(16) = "BoldUnderLine"
OfficialStyleList(17) = "Underline"
OfficialStyleList(18) = "UnderlineItalic"
OfficialStyleList(19) = "MainTextNu"
OfficialStyleList(20) = "image"
OfficialStyleList(21) = "Footer"
OfficialStyleList(22) = "Header"
OfficialStyleList(23) = "highLight1indent"
OfficialStyleList(24) = "highLightText"
OfficialStyleList(25) = "StyleOff"
OfficialStyleList(26) = "Hyperlink"
FillOfficialStyleList = 26
End Function

Private Sub FindAndHighlight(StyleName As String)
' Thanks to Dave Rado, microsoft.public.word.docmanagement, 2001-08-29

Dim oStory As Range
Dim oSection As Section
Dim oHeaderFooter As HeaderFooter
Dim StyleFound As Boolean

For Each oStory In ActiveDocument.StoryRanges
Select Case oStory.StoryType
'---------------
'Do Headers and Footers separately because cycling thru _
storyranges sometimes misses some Headers and Footers
'---------------
Case wdEvenPagesFooterStory, wdEvenPagesHeaderStory, _
wdFirstPageFooterStory, wdFirstPageHeaderStory, _
wdPrimaryFooterStory, wdPrimaryHeaderStory
'---------------
Case Else
'---------------
With oStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Format = True
.Wrap = wdFindContinue
.Style = StyleName
.Replacement.Highlight = True
If .Execute(Replace:=wdReplaceAll) Then
StyleFound = True
'---------------
Else
'if not found, search other stories of same type
'---------------
Do While Not oStory.NextStoryRange Is Nothing
'---------------
Set oStory = oStory.NextStoryRange
With oStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Format = True
.Wrap = wdFindContinue
.Style = StyleName
.Replacement.Highlight = True
If .Execute(Replace:=wdReplaceAll) Then
StyleFound = True
Exit Do
End If
End With
'---------------
Loop
'---------------
End If
'---------------
End With
'---------------
End Select
'---------------
Next oStory
'---------------
'If not found, check Headers and footers; unfortunately, this _
method of cycling through them may convert any blank headers/ _
footers into non-blankones, but at least it won't miss any out
'---------------
If Not StyleFound Then
For Each oSection In ActiveDocument.Sections
'---------------
For Each oHeaderFooter In oSection.Headers
'---------------
If oHeaderFooter.Exists Then
'---------------
If Len(oHeaderFooter.Range.Text) > 1 Then
'---------------
With oHeaderFooter.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Format = True
.Wrap = wdFindContinue
.Style = StyleName
.Replacement.Highlight = True
'---------------
If .Execute(Replace:=wdReplaceAll) Then
StyleFound = True
Exit For
End If
'---------------
End With
'---------------
End If
'---------------
End If
'---------------
Next oHeaderFooter
For Each oHeaderFooter In oSection.Footers
'---------------
If oHeaderFooter.Exists Then
'---------------
If Len(oHeaderFooter.Range.Text) > 1 Then
'---------------
With oHeaderFooter.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Format = True
.Wrap = wdFindContinue
.Style = StyleName
.Replacement.Highlight = True
'---------------
If .Execute(Replace:=wdReplaceAll) Then
StyleFound = True
Exit For
End If
'---------------
End With
'---------------
End If
'---------------
End If
'---------------
Next oHeaderFooter
'---------------
Next oSection
'---------------
End If
End Sub

 

[Jean-Guy Marcil]

(e-mail address removed) was telling us:
(e-mail address removed) nous racontait que :

Hi Jean,

And thanks that is working very very well in word 2003, but not in
word XP? I get an error

Run-time error '5834':
Item with specified name dose not exist.

it happens when it gets to .Style = StyleName (Ln 102)

This is all my code, I am very new to this, so I could be missing
somthing very simple?

Can you have a quick look? or will it only work in 2003.

This means that you have a typo either in the
Private Function FillOfficialStyleList()
function or in the document itself.

Since the code works in 2003, I guess that when you created a document in
XP, you mistyped one of the style name somewhere.


--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org