ms word 2010 macro How to select all shapes on a specific page

Question

The command ActiveDocument.Pages(1).Shapes.Range.Select doesnot seem to work in word 2010. (It used to work in word 2003).

I need to select all the shapes on a speci

Answer 1

This has already been answered by PatricK, but after looking at some more information I wanted to also post my solution, for future reference.

Another way to do this follows this outline:

1. For each page, if there are more than 2 shapes,
   • find the top-most and bottom-most shape coordinates
   • delete any shapes that don't match these coordinates

Executing the code would look similar to the following, thanks to an answer from this question:

Public Sub delete_firstlast()
'---------find the first and last shape on each page, make bold-----------
Dim pg As Page
Dim shp As Variant
Dim shp_count As Long, maxt As Long, maxb As Long
Dim del_index As Long

'for each page
For Each pg In ActiveDocument.Windows(1).Panes(1).Pages

  'find the number of shapes
  shp_count = 0
  For Each shp In pg.Rectangles
    If shp.RectangleType = wdShapeRectangle Then shp_count = shp_count + 1
  Next

  'if there are more than 2 shapes on a page, there
  'are shapes to be made bold
  If shp_count > 2 Then

    'prime the maxt and maxb for comparison
    'by setting to the first shape
    For Each shp In pg.Rectangles
      If shp.RectangleType = wdShapeRectangle Then
        maxt = shp.Top
        maxb = maxt
        Exit For
      End If
    Next

    'set maxt and maxb
    For Each shp In pg.Rectangles
      'make sure a selectable shape type is being considered
      If shp.RectangleType = wdShapeRectangle Then
        If shp.Top < maxt Then maxt = shp.Top
        If shp.Top > maxb Then maxb = shp.Top
      End If
    Next

    'Delete the top and bottom shapes
    For del_index = pg.Rectangles.Count To 1 Step -1
      If pg.Rectangles(del_index).RectangleType = wdShapeRectangle Then
        Set shp = pg.Rectangles(del_index)
        If shp.Top = maxt Or shp.Top = maxb Then
          pg.Rectangles(del_index).Range.ShapeRange.Delete
        Else
          shp.Range.ShapeRange.Line.Weight = 2
        End If
      End If
    Next

  End If
'go to next page
Next
End Sub