| |
▼カド さん：
こんにちは。
>
>目的どおりの作動が確認できました。
>
>本件の中でした質問でまだ分からないことが有りますが、
>グループ化とは直接関係無いので改めて質問しなおします。
解決されたみたいですが、バグがありました。
インターフェースをちょっと変えました。
'==========================================================
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がひとつもなかったときにエラーになってしまいました。
|
|
- 04/3/9(火) 10:45 -
