I have text having some particular style in a page while using Macro. The word document has about 90 pages. The text having style starts from 9th page. So I reach 9th page and read the first text having the style and set it as header.There are some more text's having same style on same page.
My problem is that I have to jump to next page to select the first text having style and set as header while ignoring other text's that follow on the same page. Is there a solution by using Paragraph? As it sets all the text's of the same page.
Here is my function below:
Code:
Function setCIHeader()
Dim doc As Document
Dim objParagraph As Paragraph
'Dim pgno As Integer
Set doc = Documents.Open(ActiveDocument.path & "\cumindex.chrono.en.doc")
doc.Activate
Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious, count:=10
pgno = getActualCurrentPageNo
'Dim n As Integer
n = 8
Do While pgno < n
pgno = getActualCurrentPageNo
goToNextPage
Loop
'Do While pgno >= 8
'Loop
'For Each itm In doc.ActiveWindow.Application.ActiveDocument.Paragraphs
For Each objParagraph In ActiveDocument.Paragraphs
'goToNextPage
With objParagraph
If objParagraph.style = "Chrono.conclusionyear" Then
'MsgBox (objParagraph.style)
.Range.Select
'goToPreviousPage
Selection.MoveUp Unit:=wdLine, count:=1
'Selection.InsertBreak Type:=wdSectionBreakContinuous
'Selection.MoveDown Unit:=wdLine, count:=1
'goToNextPage
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter. _
LinkToPrevious
'Selection.WholeStory
'Selection.delete Unit:=wdCharacter, count:=1
Selection.MoveDown Unit:=wdScreen, count:=1
MsgBox (Trim(objParagraph.Range.text))
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.InsertAfter (vbLf)
Selection.TypeText text:=Trim(objParagraph.Range.text)
'Selection.MoveDown Unit:=wdScreen, count:=1
'Selection.MoveDown Unit:=wdLine, count:=10
'ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
'Selection.MoveDown Unit:=wdLine, count:=3
'n = getActualCurrentPageNo + 1
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, count:=1
n = n + 1
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, count:=n
'Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, count:=2
'objParagraph.style = Nothing
'Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext
'ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'If Selection.HeaderFooter.IsHeader = True Then
'Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter. _
'LinkToPrevious
'Else
' ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'End If
'Exit Function
End If
End With
Application.StatusBar = "Setting Header in pages...Please Wait.."
Next
doc.Close savechanges:=wdSaveChanges
Application.StatusBar = "Done..."
'Loop ''New R&D
End Function
