セルに楕円を描いたり消したりするマクロ
以前、セルを楕円で囲むマクロという記事を書きました。
これはセルを右クリックするとそのセルを囲むような楕円を描画するというマクロです。
今回、「もう一度、右クリックしたら、その楕円を削除するマクロは考えられないか」というコメントをいただきました。
そこで少し考えて作り直したのが次のコードです。
Cancel = True '既定の右クリックの操作を実行しない。
flg = 0
For Each myshape In ActiveSheet.Shapes
If myshape.Top = Target.Top And myshape.Left = Target.Left Then
myshape.Delete
flg = 1
End If
Next
If flg = 0 Then
With ActiveSheet.Shapes.AddShape(msoShapeOval, _
Target.Left, _
Target.Top, _
Target.Width, _
Target.Height)
.Fill.Visible = msoFalse
.Line.Weight = 0.75
End With
End If
End Sub
楕円を描くときは、その場に描いて終わりですが、消すときは、どの楕円を消せばいいのか分かりません。
そこで、右クリックしたときに、ワークシート上にある図形をすべて検査し、図形の座標(左端と上端の位置)と右クリックしたセルの座標が同じ場合だけ、その図形すなわちセルに描かれた楕円を削除する、という方法を使っています。
そして「flg」という変数を用意し、削除をした場合には「1」をセットします。
「0」の場合は、削除の処理をしなかったことになりますので、楕円を描画します。
なお、コードの先頭に「Cancel = True」と書いています。こうすると通常の右クリックによるメニューが表示されません。
[ 2012年8月15日 | カテゴリー: Excel | タグ: VBA , 右クリック , 楕円 ]
« ロンドン五輪、日本のメダル獲得数は過去最高 | アーチェリーやダーツなどの的と距離を比較 »
コメント
-
＞みきさん
ご利用ありがとうございます。
「複数の指定範囲セルにしか適用」というのはセルが一つだけの場合は楕円を描画しないということですか。 -
みき より:
お返事ありがとうございます。
すみません説明が不足でした。
例えば以下の3つの範囲では右クリックで丸が出るようにして
A1:B10
D1:E10
G1:H10それ以外の所では右クリックしても丸が出ないようにしたいという事です。
現状では全範囲で右クリックで丸が出るので場所を制限したいのです。A2, B8,D5をそれぞれ右クリックしたら丸が出る
C4を右クリックしても丸が出ないこのような説明で分かりますでしょうか。
宜しくお願い致します。 -
＞みきさん
Cancel = True と flg = 0 の間に次のコードを挿入してください。
If Intersect(Target, Range(“A1:B10”)) Is Nothing And Intersect(Target, Range(“D1:E10”)) Is Nothing And Intersect(Target, Range(“G1:H10”)) Is Nothing Then
Exit Sub
End If
これで指定された三つの範囲以外では処理をしません。
Rangeを書き換えれば範囲を変えられます。
もっときれいな書き方があるかもしれませんが一応動きます。 -
返信遅くなり申し訳ありません。
希望通りに動作しました。
本当にありがとうございます。
今後もサイト運営頑張ってください。 -
＞みきさん
確認ありがとうございます。
意図通り動いたようでよかったです。
こちらのコードを使用してやりたいことが劇的に向上しました！
ただ、複数の指定範囲セルにしか適用できないようにしたいのですが
追加でどのようにすればよいでしょうか？どうかご教授お願い致します。
ダブルクリックでするやり方は色々見かけましたが右クリックで出来るのが凄くいいです！