none
Macro for Office 2007 including headers and sections RRS feed

  • Question

  • In the following code (find and replace from a table), I have been trying to include the substitutions in all sections of the file. I have managed to include the headers, and the substitutions, in fact, are done in headers of section 1, but not in headers of other sections of the file. Please help.

    Code:

    Sub ReplaceFromTableList() 
        Dim ChangeDoc, RefDoc As Document 
        Dim cTable As Table 
        Dim oFind, oReplace As Range 
        Dim oRngSTory As Range 
        Dim oScn As Section 
        Dim i As Long 
        Dim sFname As String 
         'Identify the document containing the table of words/phrases and their replacements
        sFname = "C:\FORMS1\changes.doc.docx" 
         'Identify the document to be processed
        Set RefDoc = ActiveDocument 
         'Open the document with the changes
        Set ChangeDoc = Documents.Open(sFname) 
         'Identify the table to be used
        Set cTable = ChangeDoc.Tables(1) 
         'Activate the document to be processed
        RefDoc.Activate 
        For i = 1 To cTable.Rows.Count 
             'Identify the cell containing the word/phrase to be replaced
            Set oFind = cTable.Cell(i, 1).Range 
            oFind.End = oFind.End - 1 
             'Identify the cell containing the replacement word/phrase
            Set oReplace = cTable.Cell(i, 2).Range 
            oReplace.End = oReplace.End - 1 
            With Selection 
                 'Start at the top of the document
                .HomeKey wdStory 
                 'Replace the words/phrases
                 
                For Each rngStory In ActiveDocument.StoryRanges 
                     
                    With rngStory.Find 
                        .ClearFormatting 
                        .Replacement.ClearFormatting 
                        .Execute findText:=oFind, _ 
                        ReplaceWith:=oReplace, _ 
                        Replace:=wdReplaceAll, _ 
                        MatchWholeWord:=True, _ 
                        MatchWildcards:=False, _ 
                        MatchCase:=True, _ 
                        Forward:=True, _ 
                        Wrap:=wdFindContinue 
                    End With 
                Next rngStory 
            End With 
        Next i 
         'Close the document with the table
        ChangeDoc.Close wdDoNotSaveChanges 
    End Sub


    • Edited by MICHASQUI Tuesday, March 5, 2013 3:00 AM
    Tuesday, March 5, 2013 2:41 AM

All replies

  • I suspect

    Sub ReplaceFromTableList()
    Dim ChangeDoc, RefDoc As Document
    Dim cTable As Table
    Dim oFind, oReplace As Range
    Dim oRngSTory As Range
    Dim oScn As Section
    Dim i As Long
    Dim sFname As String
        'Identify the document containing the table of words/phrases and their replacements
        sFname = "C:\FORMS1\changes.doc.docx"
        'Identify the document to be processed
        Set RefDoc = ActiveDocument
        'Open the document with the changes
        Set ChangeDoc = Documents.Open(sFname)
        'Identify the table to be used
        Set cTable = ChangeDoc.Tables(1)
        'Activate the document to be processed
        RefDoc.Activate
        For i = 1 To cTable.Rows.Count
            'Identify the cell containing the word/phrase to be replaced
            Set oFind = cTable.Cell(i, 1).Range
            oFind.End = oFind.End - 1
            'Identify the cell containing the replacement word/phrase
            Set oReplace = cTable.Cell(i, 2).Range
            oReplace.End = oReplace.End - 1

            For Each rngStory In ActiveDocument.StoryRanges
                With rngStory.Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    .Execute findText:=oFind, _
                             ReplaceWith:=oReplace, _
                             Replace:=wdReplaceAll, _
                             MatchWholeWord:=True, _
                             MatchWildcards:=False, _
                             MatchCase:=True, _
                             Forward:=True, _
                             Wrap:=wdFindContinue
                End With
                If rngStory.StoryType <> wdMainTextStory Then
                    While Not (rngStory.NextStoryRange Is Nothing)
                        Set rngStory = rngStory.NextStoryRange
                        With rngStory.Find
                            .ClearFormatting
                            .Replacement.ClearFormatting
                            .Execute findText:=oFind, _
                                     ReplaceWith:=oReplace, _
                                     Replace:=wdReplaceAll, _
                                     MatchWholeWord:=True, _
                                     MatchWildcards:=False, _
                                     MatchCase:=True, _
                                     Forward:=True, _
                                     Wrap:=wdFindContinue
                        End With
                    Wend
                End If
            Next rngStory
        Next i
        'Close the document with the table
        ChangeDoc.Close wdDoNotSaveChanges
    End Sub

    would be closer to what you had in mind.


    Graham Mayor - Word MVP
    www.gmayor.com

    Tuesday, March 5, 2013 7:57 AM
  • Unfortunately it gives me a "compile error: Next without for" at Next i

    Michasqui


    • Edited by MICHASQUI Tuesday, March 5, 2013 9:51 PM
    Tuesday, March 5, 2013 3:44 PM
  • There was a minor problem with a range name

    Sub ReplaceFromTableList()
    Dim ChangeDoc, RefDoc As Document
    Dim cTable As Table
    Dim oFind, oReplace As Range
    Dim oRngSTory As Range
    Dim oScn As Section
    Dim i As Long
    Dim sFname As String
        'Identify the document containing the table of words/phrases and their replacements
        sFname = "C:\FORMS1\changes.doc.docx"
        'Identify the document to be processed
        Set RefDoc = ActiveDocument
        'Open the document with the changes
        Set ChangeDoc = Documents.Open(sFname)
        'Identify the table to be used
        Set cTable = ChangeDoc.Tables(1)
        'Activate the document to be processed
        RefDoc.Activate
        For i = 1 To cTable.Rows.Count
            'Identify the cell containing the word/phrase to be replaced
            Set oFind = cTable.Cell(i, 1).Range
            oFind.End = oFind.End - 1
            'Identify the cell containing the replacement word/phrase
            Set oReplace = cTable.Cell(i, 2).Range
            oReplace.End = oReplace.End - 1

            For Each oRngSTory In ActiveDocument.StoryRanges
                With oRngSTory.Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    .Execute findText:=oFind, _
                             ReplaceWith:=oReplace, _
                             Replace:=wdReplaceAll, _
                             MatchWholeWord:=True, _
                             MatchWildcards:=False, _
                             MatchCase:=True, _
                             Forward:=True, _
                             Wrap:=wdFindContinue
                End With
                If oRngSTory.StoryType <> wdMainTextStory Then
                    While Not (oRngSTory.NextStoryRange Is Nothing)
                        Set oRngSTory = oRngSTory.NextStoryRange
                        With oRngSTory.Find
                            .ClearFormatting
                            .Replacement.ClearFormatting
                            .Execute findText:=oFind, _
                                     ReplaceWith:=oReplace, _
                                     Replace:=wdReplaceAll, _
                                     MatchWholeWord:=True, _
                                     MatchWildcards:=False, _
                                     MatchCase:=True, _
                                     Forward:=True, _
                                     Wrap:=wdFindContinue
                        End With
                    Wend
                End If
            Next oRngSTory
        Next i
        'Close the document with the table
        ChangeDoc.Close wdDoNotSaveChanges
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com

    Wednesday, March 6, 2013 5:43 AM
  • This one worked perfect Graham Mayor. Thank-you very much for your expert help.

    MICHASQUI

    Wednesday, March 6, 2013 4:42 PM