| 
    
     |  | ▼カド さん: こんにちは。
 >
 >目的どおりの作動が確認できました。
 >
 >本件の中でした質問でまだ分からないことが有りますが、
 >グループ化とは直接関係無いので改めて質問しなおします。
 解決されたみたいですが、バグがありました。
 インターフェースをちょっと変えました。
 
 '==========================================================
 Sub main()
 Dim shpnm()
 If get_shp_name(Range("a1:c10"), shpnm()) = True Then
 If UBound(shpnm) > 1 Then ActiveSheet.Shapes.Range(shpnm).Group
 End If
 End Sub
 '=================================================================
 Function get_shp_name(rng As Range, shpnm()) As Boolean
 Dim shp As Shape
 Dim sht As Worksheet
 Set sht = rng.Parent
 idx = 1
 With rng
 For Each shp In sht.Shapes
 If shp.Top >= .Top And shp.Top + shp.Height <= .Top + .Height _
 And shp.Left >= .Left And shp.Left + shp.Width <= .Left + .Width Then
 ReDim Preserve shpnm(1 To idx)
 shpnm(idx) = shp.Name
 idx = idx + 1
 End If
 Next
 End With
 If idx > 1 Then
 get_shp_name = True
 Else
 get_shp_name = False
 End If
 End Function
 
 こうして置かないと、セル範囲にShapeがひとつもなかったときにエラーになってしまいました。
 
 
 |  |