セルに楕円を描いたり消したりするマクロ

Pocket

以前、セルを楕円で囲むマクロという記事を書きました。
これはセルを右クリックするとそのセルを囲むような楕円を描画するというマクロです。
今回、「もう一度、右クリックしたら、その楕円を削除するマクロは考えられないか」というコメントをいただきました。
そこで少し考えて作り直したのが次のコードです。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    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 | タグ: , , ]

« | »

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

送信してください。


タグ

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報