Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7592 / 13646 ツリー ←次へ | 前へ→

【38017】指定セル上の楕円削除 丸尾 06/5/25(木) 10:47 質問[未読]
【38023】Re:指定セル上の楕円削除 Jaka 06/5/25(木) 11:25 発言[未読]
【38026】Re:指定セル上の楕円削除 Kein 06/5/25(木) 11:38 回答[未読]
【38098】Re:指定セル上の楕円削除 丸尾 06/5/26(金) 11:44 お礼[未読]

【38017】指定セル上の楕円削除
質問  丸尾  - 06/5/25(木) 10:47 -

引用なし
パスワード
   ご質問させてください。

指定したセルにある楕円のみを削除する方法が分からなくて
悩んでいます。

シート上5行目と10行目に1 2 3と番号があり、
Aのボタンを押すと、5行目の1 2 3の番号どれかに楕円が付いていたら削除する。
Bのボタンを押すと、10行目の1 2 3の番号どれかに楕円が付いていたら削除する。
(5,10行目で楕円はそれぞれ1つずつしか付きません)

という処理を行いたいのですが・・・

アクティブシートの楕円を削除するのはActiveSheet.Ovals.Delete
で出来るのですが、そもそもセル上にある楕円を判断して削除なんて
出来るのでしょうか?

【38023】Re:指定セル上の楕円削除
発言  Jaka  - 06/5/25(木) 11:25 -

引用なし
パスワード
   [#36626]
こんな感じに全部の図形を拾って位置を確認する手順になるみたいです。
因みにスレッド先のコードは、図形の1部がセル内に入っていればいいのか完全なのかは解りません。

【38026】Re:指定セル上の楕円削除
回答  Kein  - 06/5/25(木) 11:38 -

引用なし
パスワード
   >5行目と10行目に1 2 3と番号
というのは、セルに入力した数値のことでしょーか ?
そしてそのセルの上に、楕円の一部が重なっているということかな・・?
ま、実態としてはそうであっても、要は「5行目か10行目、もしくはどちらの
行にも楕円が一つだけある」ということを想定すればいいのですね ?
ならば配置するボタンを、フォームツールバーのものとして、以下のマクロを
二つのボタンに登録して下さい。そしてボタンのキャプションを変更する前に
デフォルトで表示されているキャプション(例えば "ボタン 13"など)の文字列を
>If x = "ボタン 13" Then
      ↑ここに指定します。
つまり "ボタン 13" は、あなたが例示した "Aのボタン" に相当するわけです。
コードの指定ができたら、ボタンのキャプションを任意のものに変更しても
結構です。変更する際はボタンを [Ctrl]キーを押しながらマウスで選択します。
そうすると登録したマクロを実行することなく、デザインモードになります。

Sub Del_Oval()
  Dim x As Variant
  Dim xR As Integer
  Dim Ov As Oval
  Dim MyR As Range

  x = Application.Caller
  If VarType(x) <> 8 Then Exit Sub
  If x = "ボタン 13" Then
   xR = 5
  Else
   xR = 10
  End If
  If ActiveSheet.Ovals.Count = 0 Then Exit Sub
  For Each Ov In ActiveSheet.Ovalus
   Set MyR = Range(Ov.TopLeftCell, Ov.BottomRightCell)
   If Not Intersect(Rows(xR), MyR.EntireRow) Is _
    Nothing Then
     Ov.Delete: Set MyR = Nothing: Exit For
   End If
   Set MyR = Nothing
  Next
End Sub

* ただし楕円が「5行目〜10行目に渡って」配置されていると
 正しく処理されない可能性があります。ご注意下さい。

【38098】Re:指定セル上の楕円削除
お礼  丸尾  - 06/5/26(金) 11:44 -

引用なし
パスワード
   Keinさん、Jakaさん、どうもありがとうございます。

私の説明が不十分で申し訳ありませんでした。
丁寧な解答のお陰で楕円削除を行うことができました。

7592 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free