1. This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn More.

Word Macro Style Paragraph

Discussion in 'Visual Basic ( VB )' started by anup.kamat, Aug 4, 2008.

  1. anup.kamat

    anup.kamat New Member

    Aug 4, 2008
    Likes Received:
    Trophy Points:
    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 a moderator: Aug 4, 2008

Share This Page