Word Macro Style Paragraph

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

  1. anup.kamat

    anup.kamat New Member

    Joined:
    Aug 4, 2008
    Messages:
    1
    Likes Received:
    0
    Trophy Points:
    0
    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:

    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
     
    Last edited by a moderator: Aug 4, 2008

Share This Page

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice