This is driving me nuts. I have a macro that is run from a drop down list in a custom toolbar. That part works fine, the argument(?) from the drop down is passed to the macro and the macro runs. It's supposed to insert a new appendix after the current section. All goes fine until it comes to manipulating the inserted cover graphic in the header. A variable keeps track of what the current section is, and when stepping through the code the variable remains correct (i.e. it always refers to the section I want to manipulate). My test document has 7 sections to start, the macro inserts another one and the "aSec" variable changes to 8 and is shown as 8 in the Watch area. However, when it comes to the line:
Code:
Set myShape = aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Shapes(1)
...and the "with myShape" part, the transformation is applied to one of the two header graphics in the header of section 3! After it does this, the text I want to insert is applied in the correct section, which is section 8.
Any idea why it's not applying the transformation to the header graphic of section 8?
Code:
Sub BuildAppendixA4(ByRef strArg As String)
Dim aDoc As Document, aSec As Long, aRng As Range, bRng As Range, bSec As Long
Dim myShape As Shape
Dim oTemplate As Template
'On Error Resume Next
aSec = Selection.Information(wdActiveEndSectionNumber)
Set aDoc = ActiveDocument
Set aRng = aDoc.Sections(aSec).Range
Set oTemplate = ActiveDocument.AttachedTemplate
'Put cursor at end of current section
aRng.Collapse Direction:=wdCollapseEnd
Selection.InsertBreak Type:=wdSectionBreakNextPage
'Make sure the view is correct
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
'Turn off link to previous in case previous appendix isn't A4 Portrait
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
With Selection.HeaderFooter
.LinkToPrevious = Not Selection.HeaderFooter.LinkToPrevious
End With
'Advance selected section by one, which puts us in the newly-created section
aSec = aSec + 1
'Set a new range which is the header of the new section, and set it to be a different first page
Set bRng = aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Range
aDoc.Sections(aSec).PageSetup.DifferentFirstPageHeaderFooter = True
'Set it to be an A4 portrait page, in case the previous appendix wasn't A4 portrait
With aDoc.Sections(aSec).PageSetup
.Orientation = wdOrientPortrait
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
End With
'Delete anything in the header already, and insert the correct cover page jpeg from building blocks
aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Range.Delete
oTemplate.BuildingBlockEntries("Appendix Cover").Insert Where:=bRng, RichText:=True
'aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Range.Select
'Set the selection to be the appendix cover jpeg, which will be the only shape in the selected header
Set myShape = aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Shapes(1)
'Make sure the A4 jpeg is the correct size and positioned correctly
With myShape
.WrapFormat.Type = wdWrapFront
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(21)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = wdShapeLeft
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeTop
End With
'Exit the header and insert the appendix heading text
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.Style = ActiveDocument.Styles("Heading 9")
Selection.TypeText Text:=Chr(11) & "Appendix Name"
Selection.TypeParagraph
Select Case strArg
Case "AppendixNextA4Portrait"
Selection.InsertBreak Type:=wdPageBreak
Selection.TypeParagraph
Case "AppendixNextA3Portrait"
Selection.InsertBreak Type:=wdSectionBreakNextPage
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
With Selection.HeaderFooter
.LinkToPrevious = Not Selection.HeaderFooter.LinkToPrevious
End With
aSec = aSec + 1
Set bRng = aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Range
aDoc.Sections(aSec).PageSetup.DifferentFirstPageHeaderFooter = False
With aDoc.Sections(aSec).PageSetup
.Orientation = wdOrientPortrait
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(42)
End With
Case "AppendixNextA4Landscape"
Selection.InsertBreak Type:=wdSectionBreakNextPage
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
With Selection.HeaderFooter
.LinkToPrevious = Not Selection.HeaderFooter.LinkToPrevious
End With
aSec = aSec + 1
Set bRng = aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Range
aDoc.Sections(aSec).PageSetup.DifferentFirstPageHeaderFooter = False
With aDoc.Sections(aSec).PageSetup
.Orientation = wdOrientLandscape
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
End With
Case "AppendixNextA3Landscape"
Selection.InsertBreak Type:=wdSectionBreakNextPage
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
With Selection.HeaderFooter
.LinkToPrevious = Not Selection.HeaderFooter.LinkToPrevious
End With
aSec = aSec + 1
Set bRng = aDoc.Sections(aSec).Headers(wdHeaderFooterFirstPage).Range
aDoc.Sections(aSec).PageSetup.DifferentFirstPageHeaderFooter = False
With aDoc.Sections(aSec).PageSetup
.Orientation = wdOrientLandscape
.PageWidth = CentimetersToPoints(42)
.PageHeight = CentimetersToPoints(29.7)
End With
End Select
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
10-20-2022, 02:42 PM
Macro is manipulating item in wrong section even though variable watch says it should be right
Similar Threads
How do I make a checkbox or dropdown item reference data in that specific section of the data array?
Windows 10 
Office 2016
Threaded Mode