Consulting

Results 1 to 9 of 9

Thread: Copy content under 6 specific headings, paste it over 6 placeholder text items

  1. #1
    VBAX Regular
    Joined
    Feb 2020
    Location
    Auckland, NZ
    Posts
    13
    Location

    Copy content under 6 specific headings, paste it over 6 placeholder text items

    The goal: for about six specifically named H1 Headings, I want to copy all the content under each heading, and paste it over specific placeholder text elsewhere in the same document.
    For example, I want to copy the contents under the heading "CONTENTS", and paste it over the placeholder text "<Contents>" in the same document, and delete the original. Then move onto the next heading "ABOUT THE AUTHOR", and paste its content over the placeholder text "<About the Author>".
    The reason: I have a macro that transforms a finished etext document into the makings of a braille-ready document (to be opened by Duxbury braille translation software). That macro adds a series of fixed headings and placeholder text content to the finished etext, in the order required of braille documents. Rather than manually move/consolidate the original file's headings with the braille ready version, I'd like a macro that does most/all of the work.
    Progress so far: I have used Greg Maxey's macro on another thread which copies the right content, and added a bit of Find and Replace code to give a better idea of where I'm going, with notes about where I need code to run through a series of headings, rather than just the one:

    Sub TextBetweenHeading1()
    'A basic Word macro coded by Greg Maxey
    'with modifications to copy content under named headings and replace specific placeholder text with it
        
        Dim docCurrent As Document
        Dim oRng As Range
        Dim oRngReplace As Range
        Set docCurrent = ActiveDocument
        Set oRng = docCurrent.Range
        
          Selection.Collapse wdCollapseEnd
          
          ' HERE I WOULD LIKE TO FIND A SERIES OF DEFINED HEADINGS, eg _
            DEDICATION, CONTENTS, COVER INFORMATION, BY THE SAME AUTHOR, ABOUT THE AUTHOR, TRANSCRIBER'S NOTE etc
            With Selection.Find
                .Style = ThisDocument.Styles("Heading 1")
                .Text = "CONTENTS^13"
                .Wrap = wdFindContinue
                If .Execute = False Then
                    MsgBox "Heading not found."
                     ' Move to next item if heading not found, which occasionally it may not be
                End If
            End With
            
          Selection.Collapse wdCollapseEnd
          Set oRng = Selection.Range
                
          oRng.Collapse wdCollapseEnd
          Do While oRng.Paragraphs(1).Style = "Heading 1"
            
            oRng.Move wdParagraph, 1
          Loop
          Do
            oRng.MoveEnd wdParagraph, 1
            oRng.Select
          Loop Until oRng.Paragraphs.Last.Range.Style = "Heading 1" Or oRng.Paragraphs.Last.Range.End = ActiveDocument.Range.End
          If Not oRng.End = ActiveDocument.Range.End Then oRng.MoveEnd wdParagraph, -1
          Do
            oRng.MoveStart wdParagraph, -1
            oRng.Select
          Loop Until oRng.Paragraphs(1).Range.Style = "Heading 1" Or oRng.Paragraphs(1).Range.Start = ActiveDocument.Range.Start
          If Not oRng.Start = ActiveDocument.Range.Start Or oRng.Paragraphs(1).Style = "Heading 1" Then oRng.MoveStart wdParagraph, 1
          oRng.Select
          oRng.Copy
         
         ' HERE WOULD BE A CORRESPONDING A SERIES OF PLACEHOLDER TEXT ITEMS THAT oRng WOULD REPLACE: _
          "<Cover Information>","<About this Book>","<By the Same Author>","<About the Author>","<Dedication>","<Transcriber's Note>", etc
         
         Set oRngReplace = docCurrent.Range
            With oRngReplace.Find
                .ClearFormatting
                .Text = "<Contents>"
                .Wrap = wdFindStop
                While .Execute
                    oRngReplace.Text = oRng.Text
                Wend
            End With
         
         ' Delete the text at original location, tho' could also now add the original H1 heading as well
            oRng.Delete
    
    
    lbl_Exit:
      Exit Sub
    End Sub

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,121
    Location
    If, instead of relying on the placeholder text, you assigned each content control a title of the same name, you could use code like:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim Rng As Range
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = ""
        .Style = wdStyleHeading1
        .Format = True
        .Forward = True
        .Wrap = wdFindStop
      End With
      Do While .Find.Execute
        If Not ActiveDocument.SelectContentControlsByTitle(Split(.Text, vbCr)(0))(1) Is Nothing Then
          Set Rng = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
          ActiveDocument.SelectContentControlsByTitle(Split(.Text, vbCr)(0))(1).Range.FormattedText = Rng.FormattedText
          Rng.Text = vbNullString
        End If
        If .End = ActiveDocument.Range.End Then Exit Do
        .Collapse wdCollapseEnd
      Loop
    End With
    Application.ScreenUpdating = True
    End Sub
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Regular
    Joined
    Feb 2020
    Location
    Auckland, NZ
    Posts
    13
    Location
    Perhaps I have confused things by the phrase "placeholder text". I'm not referring to the placeholder text of a control (there are no content controls in my files), just a bit of dummy text to remind the user where to put the copied/deleted contents. It's not even in a paragraph of its own, since the files in question use text formulas like [[*<*]] and [[*p*]] which will be converted to line breaks and paragraph markers respectively when the file is opened in Duxbury Braille Translator. (It's what the original conversion macro does: headings remain as paragraphs, and all other contents are agglomerated into single paragraphs beneath them). So I'm not sure how I could use content controls.

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,121
    Location
    In that case, try:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, StrFnd As String, RngSrc As Range, RngTgt As Range
    StrFnd = "DEDICATION|CONTENTS|COVER INFORMATION|BY THE SAME AUTHOR|ABOUT THE AUTHOR|TRANSCRIBER'S NOTE"
    For i = 0 To UBound(Split(StrFnd, "|"))
      With ActiveDocument.Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = Split(StrFnd, "|")(i)
          .Replacement.Text = ""
          .Style = wdStyleHeading1
          .Forward = True
          .Wrap = wdFindStop
          .Execute
        End With
        If .Find.Found = True Then
          Set RngSrc = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
          .Collapse wdCollapseEnd
          Set RngTgt = RngSrc.Duplicate
          RngTgt.End = ActiveDocument.Range.End
          With RngTgt
            With .Find
              .Text = "<" & Split(StrFnd, "|")(i) & ">"
              .Execute
            End With
            If .Find.Found = True Then .FormattedText = RngSrc.FormattedText
            RngSrc.Text = vbNullString
          End With
        End If
      End With
    Next
    Application.ScreenUpdating = True
    End Sub
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Regular
    Joined
    Feb 2020
    Location
    Auckland, NZ
    Posts
    13
    Location
    That looks more along the lines that I had imagined, ie a kind of array variable.

    So far, the code yields a deletion of each H1 heading and its content. But it leaves the target string untouched.

    In case I haven't been explicit enough, here's the goal using a schematic example of a file's content:

    CONTENTS (heading level 1)
    Textual content of CONTENTS, formatted (= everything in file till next heading 1 = RngSrc)

    CONTENTXS (heading level 1)
    [[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]<CONTENTS>[[*<*]][[*pg*]]etc (= new location showing where RngSrc should be plonked, ie replacing RngTgt = <CONTENTS> )

    The result would be:

    CONTENTXS
    [[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]Textual content of CONTENTS, formatted[[*<*]][[*pg*]]etc

    ... and spelling of headings would be tidied up later.

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,121
    Location
    Quote Originally Posted by Walentyn View Post
    CONTENTXS (heading level 1)
    [[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]<CONTENTS>[[*<*]][[*pg*]]etc (= new location showing where RngSrc should be plonked, ie replacing RngTgt = <CONTENTS> )

    The result would be:

    CONTENTXS
    [[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]Textual content of CONTENTS, formatted[[*<*]][[*pg*]]etc.
    Which is exactly what the code does. The <CONTENTS> string is replaced by all of the content associated with the corresponding Heading 1 range. Everything else is left alone.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    VBAX Regular
    Joined
    Feb 2020
    Location
    Auckland, NZ
    Posts
    13
    Location
    Hi Paul,
    After further testing, I got the code to work by adding the .Wrap line to find the target <dummy text>:

    With RngTgt
            With .Find
              .Wrap = wdFindContinue
              .Text = "<" & Split(StrFnd, "|")(i) & ">"
              .Execute
            End With
            If .Find.Found = True Then .Text = RngSrc.Text
            RngSrc.Text = vbNullString
          End With
    Ideally the RngSrc would also drop the Heading 1 heading itself. Is it easy to alter the source range by knocking off the first paragraph heading?

    Cheers
    Chris

  8. #8
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,121
    Location
    Quote Originally Posted by Walentyn View Post
    I got the code to work by adding the .Wrap line to find the target <dummy text>:
    That suggests your array items are not in the same order as the items appear in the document.
    Quote Originally Posted by Walentyn View Post
    Ideally the RngSrc would also drop the Heading 1 heading itself. Is it easy to alter the source range by knocking off the first paragraph heading?
    After:
    Set RngSrc = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    insert:
    RngSrc.Paragraphs.First.Range.Text = vbNullString
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  9. #9
    VBAX Regular
    Joined
    Feb 2020
    Location
    Auckland, NZ
    Posts
    13
    Location
    This is a stunning result. The whole procedure now works exactly as intended. It was the last piece of the puzzle in a bigger procedure, so thank you very much indeed for that.

    Thanks also for the explanation about the order of array items. Good to know better how that should work. As for modifying range objects, well, you make it look so simple! I suppose it is when you know how.

    Thanks again.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •