システムメンテナンスのお知らせ

I5:I24の範囲内のオートシェイプの数を数え、I25に合計数を表示させるマクロを作っているのですが、どうしても範囲指定の仕方が分かりません。教えてください。

'オートシェイプの合計数算出
Dim shp As Object
Dim cnt As Long
For Each shp In ActiveSheet.Shapes
If shp.Type = msoAutoShape Then
If shp.TopLeftCell.Column = 9 Then
cnt = cnt + 1
End If
End If
Next shp
Range("I25").Value = cnt
このマクロのどこにどう入れればよいでしょうか?

gooドクター

A 回答 (3件)

TopLeftCellプロパティとIntersect メソッドを使って


図形の左上端が範囲内にあるか判定します

Dim shp As Object
Dim cnt As Long

For Each shp In ActiveSheet.Shapes
  If shp.Type = msoAutoShape Then
    If Not Intersect(shp.TopLeftCell, Range("I5:I24")) Is Nothing Then
      cnt = cnt + 1
    End If
  End If
Next shp
Range("I25").Value = cnt

図形の右下も含めるのならBottomRightCellプロパティ
も条件に含めてください
    • good
    • 0
この回答へのお礼

お礼遅くなり申し訳ありません。
ありがとうございました。

お礼日時:2010/10/04 13:52

もともとオートシェイプなどの、シート上のオブジェクトは、シートに浮かんで要るようなもので、EXCELのシートのセルとは何の関係もないものです。

すなわちセルの属性ではない。
しかしそれでは不便な場合もあるので、
Sub test01()
MsgBox ActiveSheet.Shapes.Count
MsgBox ActiveSheet.Shapes(1).Name
MsgBox ActiveSheet.Shapes(1).TopLeftCell.Address
MsgBox ActiveSheet.Shapes(1).BottomRightCell.Address
MsgBox ActiveSheet.Shapes(1).BottomRightCell.Column
End Sub
をやるとわかるように、位置関係について、オブジェクト側から
TopLeftCell、BottomRightCellの属性を使えるようになっている。
ほかに「オートシェイプの書式設定」の「プロパティ」の「セルにあわせて・・」のような仕組みがあるだけである。
ーー
だから、質問の、「範囲指定の仕方と言っても、TopLeftCell等の番地が、質問者の考える範囲内にある(InterSectする)か聞くほかない。
これもオブジェクトの位置を動かすと変わる不安定なものである。
ーー
InterSectを使わないなら、ActiveSheet.Shapes(1).TopLeftCellなどのRowとColumnについて、列について2よりで大6より小、且つ行について3より大で8より小のような判別(IFで)プログラムでやることになる。
ーーー
TopLeftCellとBottomRightCell のどちらを問題にするのか、両方を考えるかの問題は、当然ある。
    • good
    • 0
この回答へのお礼

お礼遅くなり申し訳ありません。
ありがとうございました。

お礼日時:2010/10/04 13:51

>範囲内のオートシェイプの数



この表現はちょっとあやふやです。
範囲に完全に入っているものの数か
範囲に少しでも入っているものの数か
どちらでしょう。

で、2通り数えるコードを。。

'------------------------------------------
Sub Test()
 Dim Shp As Shape
 Dim Cnt1 As Long
 Dim Cnt2 As Long
 Dim myRange As Range

 Set myRange = Range("H1:J20") '●調査範囲、適宜に変更

For Each Shp In ActiveSheet.Shapes
 If Shp.Type = msoAutoShape Then

'●範囲内に完全に入っているSHAPE
 If Not Intersect(Shp.TopLeftCell, myRange) Is Nothing And _
  Not Intersect(Shp.BottomRightCell, myRange) Is Nothing Then
    Cnt1 = Cnt1 + 1
 End If

'●範囲内に一部でも入っているSHAPE
 If Not Intersect(Shp.TopLeftCell, myRange) Is Nothing Or _
  Not Intersect(Shp.BottomRightCell, myRange) Is Nothing Then
    Cnt2 = Cnt2 + 1
 End If

 End If
Next Shp

  Range("I25").Value = Cnt1
  Range("I26").Value = Cnt2
End Sub
'-----------------------------------------------

以上です。
 
    • good
    • 0
この回答へのお礼

お礼遅くなり申し訳ありません。
ありがとうございました。

お礼日時:2010/10/04 13:53

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング