Finding Headers

[clifftech]

I need to find and list two different header styles. Using macros I have been able to come up with finding each header but would like to do it with one macro using and OR statement for Header 2 or Header 6. Can I use an OR statement to find the two headers?


Selection.Find.ClearFormatting


Selection.Find.Style = ActiveDocument.Styles("Heading 2")
Selection.Find.Style = ActiveDocument.Styles("Heading 6")

Selection.Find.ParagraphFormat.Borders.Shadow = False
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute

Thanks for the help.

 

[fumei]

1. Yes, you could use an OR. You could loop through the paragraph collection;

2. Range is better than Selection;

3. What does "find and list" really mean? What exactly are you trying to do?

Gerry

 

[clifftech]

I need a macro that will go through the word document and list the text from heading 2 and heading 6 styles in an excel spreadsheet. I have a macro that will list heading 2 text in a spreadsheet indicated below but how do I also get it to include heading 6 text?


Sub List_Summary_Heading2or6()

Dim Check, Counter
Dim oExcel As Excel.Application
Dim excWorkbook As Excel.Workbook

Selection.HomeKey Unit:=wdStory

Set oExcel = CreateObject("Excel.Application")
Set excWorkbook = oExcel.Workbooks.Open("Book5.xls")
oExcel.Visible = True

Selection.Find.ClearFormatting


Selection.Find.Style = ActiveDocument.Styles("Heading 2")

With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute

Do While Selection.Find.Found = True
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
Selection.MoveDown Unit:=wdLine, Count:=1

oExcel.Selection.Offset(rowOffset:=0, columnOffset:=0).Select
oExcel.ActiveCell.PasteSpecial (xlPasteValues)

oExcel.Selection.Offset(rowOffset:=1, columnOffset:=0).Select

Selection.Find.Execute
Loop

oExcel.Quit

End Sub