
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
このマクロのどこにどう入れればよいでしょうか?
No.1ベストアンサー
- 回答日時:
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プロパティ
も条件に含めてください
No.3
- 回答日時:
もともとオートシェイプなどの、シート上のオブジェクトは、シートに浮かんで要るようなもので、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 のどちらを問題にするのか、両方を考えるかの問題は、当然ある。
No.2
- 回答日時:
>範囲内のオートシェイプの数
この表現はちょっとあやふやです。
範囲に完全に入っているものの数か
範囲に少しでも入っているものの数か
どちらでしょう。
で、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
'-----------------------------------------------
以上です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
みんなに挑戦してほしい「色彩検定」
これまで多くの方々が受検したが「色彩検定」。その目的や活用法は人それぞれ。今回は、色彩検定に影響を受けた男女3名にインタビュー。
-
オブジェクトをカウントする
Excel(エクセル)
-
エクセルで○や×の図形の集計は出来ますか?
Excel(エクセル)
-
Excel(VBA)
Excel(エクセル)
-
4
Excelで特定のオートシェイプのみカウントする方法はありますか?
Excel(エクセル)
-
5
特定の名前のオートシェイプの有無を知りたい(エクセルVBA)
Excel(エクセル)
-
6
VBAのロジックでEXCEL上にShape図形があるかないかをチェック
Excel(エクセル)
-
7
Excel VBAでセル内の画像を選択したい
Excel(エクセル)
-
8
エクセルVBAでセル番地を指定してオブジェクト名取得
Excel(エクセル)
-
9
エクセルvbaでの図形のカット(コピー)ペーストについて
Excel(エクセル)
-
10
エクセルマクロで指定範囲内の図形を削除
Excel(エクセル)
-
11
Excelの任意セル上に図形がのっているかどうか?
Excel(エクセル)
-
12
EXCEL VBAでオートシェイプの重なりを検知するには?
Excel(エクセル)
-
13
ユーザーフォームを表示中にシートの操作をさせるには
Excel(エクセル)
-
14
エクセルVBA 図形の選択法は?
Visual Basic(VBA)
-
15
VBA:ユーザーフォームのマルチページに色を付けたい。
Word(ワード)
-
16
VBA Shapes コピーと名前
Excel(エクセル)
-
17
Excel VBAでのWorksheet_Changeが動作しない原因
Excel(エクセル)
-
18
Application.ScreenUpdating = Falseが効きません
Visual Basic(VBA)
-
19
【VBA】3個の図形をコピーしてSheet2に貼り付けたい
Excel(エクセル)
-
20
EXCEL VBAで 図形を中央寄せに関して質問です
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
人気Q&Aランキング
-
4
方程式 e^x=x+1 の解
-
5
指定範囲内のオートシェイプを...
-
6
連立不等式を満たす整数の個数...
-
7
極座標ではr>0の時のみ考えて、...
-
8
2つの二次不等式の同時に満た...
-
9
エクセルで(~以上,~以下)...
-
10
整式の公約数・公倍数について
-
11
受験時の外積の使用について
-
12
DCOUNTA関数で複数範囲を選択する
-
13
お教えで来る範囲内で 文言が変...
-
14
絶対値のついた2つの不等式に...
-
15
VLOOKUP関数での範囲指...
-
16
「余年」の意味について教えて...
-
17
連立方程式の整数解の個数の問...
-
18
エクセルでPrint Area と表示さ...
-
19
離れた列での最大値の求め方
-
20
θが微小の時、sinθ=θ、cosθ=1と...
おすすめ情報
公式facebook
公式twitter