Select all shapes in region at Microsoft Excel 2011 (mac).

SelectAllShapesInRegion.vba

' This code is from http://social.msdn.microsoft.com/Forums/ja-JP/f0993879-8bb8-4e31-9198-8b378615379f/excel2011macvba?forum=vbajp
Sub SelectAllShapesInRegion()
'Shapesかセル範囲を選んで起動すると、その範囲内のShapeを選択する。
'
Dim i As Integer        '選択するアイテム番号配列の添字
Dim j As Integer        'シート内Shapesのアイテム番号
Dim k As Integer        'シート内にあるShapeオブジェクトの数
'
Dim temp As Integer         '起動前に選ばれているオブジェクトの位置
Dim o As Object                 '検査するオブジェクト
Dim Itemlist() As Integer    '選択するアイテム番号配列
'
Dim xTop As Integer, xBottom As Integer, xLeft As Integer, xRight As Integer
xTop = 32767
xBottom = 0
xLeft = 32767
xRight = 0
'
    If TypeName(Selection) = "DrawingObjects" Then
        '起動時複数オブジェクトが選択されている場合は、"DrawingObjects"が返る
        'その場合、オブジェクトを順次調べて範囲を算出する。
        For i = 1 To Selection.ShapeRange.Count
            temp = Selection.ShapeRange(i).Top
            If temp <= xTop Then xTop = temp
            temp = Selection.ShapeRange(i).Top + Selection.ShapeRange(i).Height
            If temp >= xBottom Then xBottom = temp
            temp = Selection.ShapeRange(i).Left
            If temp <= xLeft Then xLeft = temp
            temp = Selection.ShapeRange(i).Left + Selection.ShapeRange(i).Width
            If temp >= xRight Then xRight = temp
        Next i
    Else
        '起動時セル範囲又は単数オブジェクトが選択されている場合はその対角を調べる。
        xTop = Selection.Top
        xBottom = Selection.Top + Selection.Height
        xLeft = Selection.Left
        xRight = Selection.Left + Selection.Width
    End If
'    Debug.Print xTop, xBottom, xLeft, xRight
'
k = ActiveSheet.Shapes.Count    'シートの中のオブジェクトの数
ReDim Itemlist(k - 1)
i = 0
For j = 1 To k
    '調べた対角の範囲内にあるオブジェクトかどうかを調べ、
    '範囲内にある場合にはnamelist配列に追加する。
    Set o = ActiveSheet.Shapes(j)
    If _
        o.Top >= xTop And _
        (o.Top + o.Height) <= xBottom And _
        o.Left >= xLeft And _
        (o.Left + o.Width) <= xRight Then
            Itemlist(i) = j
            i = i + 1
    End If
Next
If i = 0 Then Exit Sub
'
'オブジェクトを選び直す。
'何故かexcel2004ではエラーになる。
ActiveSheet.Shapes.Range(Itemlist).Select
'
End Sub