Hello All,

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:

Function setCIHeader()

    Dim doc As Document
    Dim objParagraph As Paragraph
    'Dim pgno As Integer
    Set doc = Documents.Open(ActiveDocument.path & "\cumindex.chrono.en.doc")
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious, count:=10

        pgno = getActualCurrentPageNo
        'Dim n As Integer
        n = 8
      Do While pgno < n
      pgno = getActualCurrentPageNo
     'Do While pgno >= 8

    'For Each itm In doc.ActiveWindow.Application.ActiveDocument.Paragraphs
    For Each objParagraph In ActiveDocument.Paragraphs
        With objParagraph
            If objParagraph.style = "Chrono.conclusionyear" Then
                'MsgBox (objParagraph.style)
                Selection.MoveUp Unit:=wdLine, count:=1
                'Selection.InsertBreak Type:=wdSectionBreakContinuous
                'Selection.MoveDown Unit:=wdLine, count:=1
                ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
                Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter. _
                '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
                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. _

     '       ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    'End If
                'Exit Function
            End If
        End With
        Application.StatusBar = "Setting Header in pages...Please Wait.."
   doc.Close savechanges:=wdSaveChanges
   Application.StatusBar = "Done..."
   'Loop ''New R&D
End Function

Last edited by shabbir; 4Aug2008 at 12:50.. Reason: Code block