- 締切済み
EXCEL VBAでオートシェイプの重なりを検知するには?
- みんなの回答 (2)
- 専門家の回答
みんなの回答
- imogasi
- ベストアンサー率27% (4737/17068)
Left .Top .Height .Width で決まる長方形は、その中にシェイプが収まる四角形で、実際のシェイプの形とは、関係したものでは有りません。だからセルの場合はINTERSECTで判りますが、実際の図形の閉曲線輪郭が他の図形のそれと交わるか(共通点集合を持つかどうか)は、もう少し、細かいレベルのロジックやアルゴリズムによる、ビットをチェックする、アセンブラレベルのコーディングが要るのではないでしょうか。 (図形内を、色で塗りつぶしするロジックのような) 経験したような意見に書いてますが、体験したわけでなく、そういう道理だと思うわけです。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。 今、思いつくのは、以下のように、Rangeオブジェクトをとる方法ですね。 With ActiveSheet.Shapes(1) Set shp = Range(.TopLeftCell, .BottomRightCell) End With これで、Rangeオブジェクトが取れますから、それを、Intersect を使って、二重ループでまわしたらいかがですか?あまり深く考えていないので、間違っているかもしれません。 簡単な例を考えてみました。 Sub CheckDoubleTest() Dim ShpR1 As Range Dim ShpR2 As Range Dim i As Integer Dim j As Integer With ActiveSheet For i = 1 To .Shapes.Count Set ShpR1 = .Range(.Shapes(i).TopLeftCell, .Shapes(i).BottomRightCell) For j = i + 1 To .Shapes.Count If i <> j Then Set ShpR2 = .Range(.Shapes(j).TopLeftCell, .Shapes(j).BottomRightCell) If Not Intersect(ShpR1, ShpR2) Is Nothing Then '処理 End If End If Next j Next i End With Set ShpR1 = Nothing: Set ShpR2 = Nothing End Sub
お礼
ありがとうございます。 自分なりに改良して、このコードを理解しました。 INTERSECTで出きるかちょっと検討してみます。
関連するQ&A
- VBAでオートシェイプの制御?
エクセルマクロでセルにオートシェイプを張る方法を調べていて、ここで丁度いいのを見つけました。 http://oshiete1.goo.ne.jp/kotaeru.php3?q=808898 見つけた下記のマクロを実際にやってみました。 A1に1を入れるとB2にハートマークが出ます。 しかし、さらに2を入力してもB2のハートは削除されてくれません。 さらに1をいれると、ハートの上にハートが重なってしまいます。 1ならハート、それ以外の入力ならハートが消えるようにするにはどうすればいいのでしょうか? Private Sub Worksheet_Change(ByVal Target As Range) If Target <> Range("A1") Then Exit Sub If Target.Value = 1 Then With ActiveSheet.Range("B2") ActiveSheet.Shapes.AddShape(Type:=msoShapeHeart, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select End With End If End Sub
- ベストアンサー
- オフィス系ソフト
- excelVBAのオートシェイプ幅設定について
いつもお世話になっております。 以前こちらでお教えしてもったVBAを試してみたのですが、うまくいきません。 自分なりに調べてきたつもりですが、オートシェイプの幅を時間と結びつけるやり方がよくわかりません。 A2=14:30 A3=15:15 A4=45 B C D … 3行目 0 1 2 … で、4行目に、A2~A3のオートシェイプを時間の列と対応するよう作成したいのですが、幅が長くなりすぎてしまいます。 Columns("A:Z").ColumnWidth = 9 変数S = Cells(4, 2) 変数E = Cells(4, 25) ★変数Width = 変数E.Left + 変数E.Width - 変数S.Left 変数Height = 変数E.Height 変数Top = 変数S.Top ★変数Min = 変数Width / 1440 ★変数Start = Cells(1, 2).Value * 1440 * 変数Min + 変数S.Left 変数End = Cells(1, 3).Value * 24 ★変数2Width = Cells(1, 4).Value * 変数Width ActiveSheet.Shapes.AddShape(msoShapeRectangle, 変数Start, 変数Top, 変数2Width, 変数Height).Select となっていますが、 ★部分がよくわかりません。 変数Width = 変数E.Left + 変数E.Width - 変数S.Left を求めて、なぜ、A4に*ことになるのか。 1440はどこからきた数字なのか。 そもそもこの式自体が間違っているのでしょうか。 トンチンカンな質問になっていたら申し訳ございません。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- オートシェイプの位置
エクセルですが。 セレクトされているオートシェイプを所定の位置に配置するマクロとして、以下は動作するのですが。 Selection.ShapeRange.Left = 250 Selection.ShapeRange.Top = 100 名前ボックスからオートシェイプの名前を aaa に変更し、以下のマクロを実行すると、いずれもエラーになってしまいます。 aaa.ShapeRange.Left = 250 aaa.ShapeRange.Top = 100 aaa.Left = 250 aaa.Top = 100 どこが間違っているのでしょうか?
- ベストアンサー
- オフィス系ソフト
- エクセルVBA オートシェイプを操作したいです
エクセルでセルの入力内容によって楕円をオートシェイプで出現させたいと思います。 http://oshiete1.goo.ne.jp/qa809742.htmlで見つかったものを参考にし、 Private Sub worksheet_Activate() Dim Shp As Shape Set P11 = Range("P11") If P11 Is Nothing Then Exit Sub If P11.Value = 1 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N14:N15") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left,TOP:=.TOP,Width:=.Width,Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N14").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp End If If P11.Value = 2 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N16") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left, TOP:=.TOP, Width:=.Width, Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N16").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp End If End Sub とつなげて見ました。 動くには動くのですが、データ元のセルがP11からT30と100セルあり、さらにP11に入力されるデータが1,2,3,4の4種類、AQ11に5,6,7,8,9の5種類などと、ばらばらです。 P11に1が入力されるとN14:N15(結合されています)に円が入り、2が入力されるとN16に円が入る。 Q11に5が入力されるとR13に円が入り、6が入力されるとR14:R15に円が入る・・・・のようにしたいのです。 一生懸命、セルNo.を打ち込んでいたら、 「コンパイルエラー:プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。
- ベストアンサー
- その他MS Office製品
- ExcelでVBAを利用してオートシェイプ情報取得
Excelのオートシェイプをテキストデータに変化するVBAを作成したいです ただし対象となるオートシェイプは複数のオートシェイプがグループ化された グループオブジェクトになっています それら特定のパターンを持つオートシェイプオブジェクトの一群があり 1つ1つには想定される名称が存在します 具体的な操作としては複数のオートシェイプオブジェクトを横に並べたイメージダイアグラムを 作成し、それらにそって対応するテキストを配置していきたいというものです このようなオートシェイプの情報をうまく拾う方法、テキストデータと紐づける方法はありませんでしょうか よろしくお願いいたします
- ベストアンサー
- Visual Basic
- オートシェイプの位置がずれる件について教えてください
VBのエクセル操作で繰り返し処理を行うとオートシェイプの開始位置がずれていくのですが対処方法を教えてください。 Excel ver.2007 OS XP pro プログラム With xlSheet.Shapes.AddShape(msoShapeOval, _ xlSheet.Range("E1").left + 5, xlSheet.Range("A" & Cell_Kaigyou).top + 8, xlSheet.Range("A1").Height, xlSheet.Range("A1").Width) Cell_Kaigyou = Cell_Kaigyou + 1 'セル行数
- 締切済み
- Visual Basic
- オートシェイプが消えたり出たりする
Windows 7+ Excel 2013を利用しています。 オートシェイプを200個位(四角、丸)入れています、重ね合わせはありません。 エクセルで職場のレイアウトを作成・更新しているのですが、 突然、全てのオートシェイプが表示されなくなり、オートシェイプがあるあたりの セルをクリックしたら、幾つかのオートシェイプが表示され、マウスを動かすと オートシェイプが消えてしまいます。 また、別のセルをクリックしたら、先とは、違うパターンで幾つかオートシェイプが 表示され、マウスを動かすと、何個かオートシェイプが表示されたまま、他のが消えます。 オブジェクトの選択と表示では、全て表示になっていますが、一旦、全て非表示にして、全て表示にしても、全く、オートシェイプが表示されません。 慌てて、保存せずに、終了して、パソコンを再起動、変になったエクセルブックを開いても直っていません。 仕方なく、先月のブックをコピーして、修正しています。 変になったエクセルブックですが、他のパソコン何台かで開いても同じようになります。 マクロでもあるのかと思い、Alt + F10を押してみましたが、コードは書かれていません。 諦めかけていたら、調べていないPCから開いたら、表示されています。 そこで、そのPCで上書き保存してから、変になったPCで開いたら、表示されています。 何故なんでしょうか? エクセルブックは、壊れてなかったんでしょうか?
- ベストアンサー
- Excel(エクセル)
- excel上のオートシェイプを,オートシェイプのままwordに貼り付け
excel上のオートシェイプを,オートシェイプのままwordに貼り付けたい。 excel2007上のオートシェイプをword2007に貼り付けると画像となって貼り付いてしまい,その後の細かな微調整ができません。以前のバージョン(excel2003→word2003)では問題なくできました。 wordに貼り付ける際,「形式を選択して貼り付け」にしてやってみたのですがダメでした。おわかりになるかる方,よろしくお願いします。 私は,excel上ではAltキーを使うと,オートシェイプの位置がピタッとそろってくれるのでexcelでオートシェイプの図を作った後,wordにのせるということをよくやっていました。
- ベストアンサー
- その他MS Office製品
- エクセルでオートシェイプをデータによって移動できますか?
エクセルでオートシェイプをデータによって自動で移動させる事は可能でしょうか? 例えば、 『血液型 : A・B・O・AB』 という項目があって、血液型によって○で囲む書式の場合に(血液型がA型ならば、Aを○で囲む)他のセルで血液型を入力して、その値が変更する事によって、囲む○(オートシェイプを使用)の位置を自動で移動させたい。 VBAはほとんどわからないので、マクロ使用程度でできたら、と思っています。 エクセルのバージョンは2003です。
- ベストアンサー
- Windows XP
- エクセル オートシェイプ
ご教授下さい。 エクセルでオートシェイプを使用しようとしたところ、 左下の 「オートシェイプ」をクリック、線や基本図形など すべて使用できなくなっていました。 通常は、選択すると黒線が出てますが、線が真っ白です。 このエクセルの書類は、知人を介して送られてきたものです。 シートやブックの保護などはしておりませんし、特別な保護 もしてないと言われました。 他のエクセル書類や新規にエクセルを立ち上げた場合は、ちゃ んとオートシェイプは使用できます。 解除の仕方、設定方法がございましたら教えて下さい。 何卒宜しくお願い申し上げます。
- ベストアンサー
- その他([技術者向] コンピューター)
お礼
なるほど、よく分かりました。ありがとうございます。 重なりをチェックできるプロパティー値とかは、やっぱりないんですね。セルレベルの重なりチェックでできるかどうか検討してみます。INTERSECT知りませんでしたので助かりました。 ありがとうございました!