Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Accessing shape in current page header

Tags:

ms-word

vba

I have a word document with multiple sections that contains some "separator pages," which are pages with a page-filling rectangle in the page header, so that they can use a user-defined background color. These background colors I would like to be able to change via a macro that should be run when the user doubleclicks on a seperator page.

This kind of works (yes, I'm sure the code could be written a bit nice with a With block or so (I'm a C# guy, this is just a side project):

Private Sub App_WindowBeforeDoubleClick(ByVal Sel As Selection, Cancel As Boolean)    
    Dim sectionNumber As Long

    sectionNumber = ActiveDocument.ActiveWindow.Selection.Information(wdActiveEndSectionNumber)

    Dim i As Integer
    Dim shapeCount As Integer
    shapeCount = ActiveDocument.Sections(sectionNumber).Headers(wdHeaderFooterPrimary).Shapes.Count
    For i = 1 To shapeCount
        ActiveDocument.Sections(sectionNumber).Headers(wdHeaderFooterPrimary).Shapes(i).Fill.ForeColor.RGB = RGB(255, 0, 0)
        ActiveDocument.Sections(sectionNumber).Headers(wdHeaderFooterPrimary).Shapes(i).Fill.BackColor.RGB = RGB(255, 0, 0)
    Next i
End Sub

Of course I still need to add code to detect whether the user actually doubleclicked on a separator page etc.

But the big problem now is that the header contains the shapes for ALL seperator pages, not just the current one, even though they're in different sections!

And they're not even necessarily in the order they appear in the document, it seems. So how can I find the shape for the current separator page?

like image 898
TravelingFox Avatar asked Oct 26 '25 06:10

TravelingFox


1 Answers

If you address the Shapes collection of a Header you will, as you've discovered, pick up all the Shapes in all the headers.

Instead, address the Header.Range.ShapeRange - that should return only the Shapes anchored in the specific Header's Range.

ActiveDocument.Sections(sectionNumber).Headers( _
  wdHeaderFooterPrimary).Range.ShapeRange(i).Fill.ForeColor.RGB = RGB(255, 0, 0)

Note 1: You can make your code more efficient (faster, which is especially relevant if you ever use the interop in C#) and more readable by assigning an object, rather than always fully qualifying an object hierarchy:

Dim hdr as Word.HeaderFooter
Set hdr = ActiveDocument.Sections(sectionNumber).Headers(wdHeaderFooterPrimary)

Note 2: if you're looking to optimize your VBA code you can use For Each...Next to loop a collection:

Dim shp as Word.Shape
For Each shp in hdr.Range.ShapeRange

Next
like image 185
Cindy Meister Avatar answered Oct 28 '25 19:10

Cindy Meister