0

マクロ設定方法について ３つの項目からひとつをダブルクリックで選択しすると丸で囲まれるというマクロを作成しました。
逆に同じことをすると丸が消えます。

D9・E9・F9（Ｇとセルを結合しています）この三箇所にそれぞれひとつずつ項目を設けておりどれか選ぶ感じです。


現在の状態として
A B C D E F G H I J K
9 赤 青 黄 備考（Ｈ～Ｋのセルを結合し、備考欄にしています）
10 赤 青 黄 備考
11 赤 青 黄 備考
12 赤 青 黄 備考
13 赤 青 黄 備考
:
:
:
23まで続きます。
黄色のみＦＧのセルを結合しています。

そこで以下のようなマクロをシートモジュールに組みましたが、


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Shp As Shape
Dim Rng As Range
Dim TgRng As Range
Dim Flg As Boolean
Set TgRng = Range("D9:FG" & Cells(Rows.Count, 1).End(xlUp).Row)
Set Rng = Intersect(TgRng, Target)
If Rng Is Nothing Then Exit Sub
Cancel = True
With Range(Cells(Rng.Row, 1), Cells(Rng.Row, 5))
For Each Shp In ActiveSheet.Shapes
If TypeName(Shp.DrawingObject) = "Oval" Then
If Not Intersect(.Cells, Shp.TopLeftCell) Is Nothing Then
If Not Intersect(Rng, Shp.TopLeftCell) Is Nothing Then Flg = True
Shp.Delete
End If
End If
Next
If Not Flg Then
With ActiveSheet.Shapes.AddShape(msoShapeOval, _
Rng.Left, Rng.Top, Rng.Width, Rng.Height)
.Fill.Visible = msoFalse
End With
End If
End With
Set Rng = Nothing
Set TgRng = Nothing
End Sub

F9G9を結合した黄の部分に丸はつくのですが、再びダブルクリックしても消えないようになっています。
また、H～Kの備考欄にも楕円形の丸がついてしまい消せない状態です。

赤を選択し、訂正で青を選択すると丸も赤から青へ自動に移ります。

黄色の部分を消せるようにするのと、備考欄は普通に文字が打てるようにするにはどのように改善していけばよいでしょうか？？
皆様よろしくお願いします。

質問者が選んだベストソリューション

Yahoo!知恵袋 4024日前