View Single Post
 
Old 02-12-2016, 08:26 AM
Dretherix Dretherix is offline Windows 8 Office 2013
Novice
 
Join Date: Feb 2016
Posts: 4
Dretherix is on a distinguished road
Default Copy, Paste, and Format Multiple Headings

I tried to make an edit to my earlier post with the same title, but it looks like I deleted it entirely. Not sure exactly what happened, but apologies. Here is my rewrite.

This is my first time trying to create a macro in Word and I'm stuck. I'm trying to automate a tedious process where I used multiple Heading 1 (title), Heading 2 (author) and Heading 3's (date) to create a table of contents. I've tried using the building ToC tool, but it doesn't allow for the customization that I need. Basically, what I need to do is take the first H2, copy and paste it at the top of the page, italicize it, put a colon after it, copy and paste H1 after the colon, hyperlink that back to where it's located in the body of the doc, then add a space and put H3 in parentheses so that it always follows the (Month Day, Year) format. And then do it again for the next set.

Here is what the first one should look like:

Author: Title (February 12, 2016)

And here is what that is pulling from:

Title (H1)
Author (H2)
12 Feb 2016 (H3)

I've cobbled together bits and pieces from this and other forums and pasted what I have below. However, it pastes both H1 and H2 twice, and I'm not even close to figuring out how to put them on the same line, italicize and hyperlink. I wish I had a better attempt to include, but I'm struggling. Any help would be greatly appreciated.

Here is what I have so far:

Code:
Sub HeadingTest4()
'
' HeadingTest4 Macro
'
'
While Selection.Characters.Last.Next.Style = "Heading 1"
    Selection.MoveEnd Unit:=wdCharacter, Count:=1
  Wend
  Selection.MoveStart Unit:=wdCharacter, Count:=1
  Selection.Collapse Direction:=wdCollapseEnd
  With Selection.Find
    .ClearFormatting
    .Text = ""
    .MatchWildcards = False
    .Forward = True
    .Style = ActiveDocument.Styles("Heading 1")
    .Execute
    .ClearFormatting
  End With
    Selection.Find.Execute
    Selection.Copy
    Selection.MoveUp Unit:=wdWindow, Count:=1
    Selection.PasteAndFormat (wdListDontMerge)
    Selection.PasteAndFormat (wdFormatPlainText)
While Selection.Characters.Last.Next.Style = "Heading 2"
    Selection.MoveEnd Unit:=wdCharacter, Count:=1
  Wend
  Selection.MoveStart Unit:=wdCharacter, Count:=1
  Selection.Collapse Direction:=wdCollapseEnd
  With Selection.Find
    .ClearFormatting
    .Text = ""
    .MatchWildcards = False
    .Forward = True
    .Style = ActiveDocument.Styles("Heading 2")
    .Execute
    .ClearFormatting
  End With
    Selection.Find.Execute
    Selection.Copy
    Selection.MoveUp Unit:=wdWindow, Count:=1
    Selection.PasteAndFormat (wdListDontMerge)
    Selection.PasteAndFormat (wdFormatPlainText)
End Sub
Reply With Quote