エクセルのＶＢＡについて

エクセル2003にて、チェックボックスのオン・オフを利用して指定セルへの楕円の挿入と削除をしたいと考えております。
具体的にはオンの時に別シートの指定したセルに楕円を作り、オフの時にそれを削除したいのです。

チェックボックスのクリックで指定セルに楕円を挿入するようには下記の通りで出来たのですが、
その楕円を削除する方法と、
チェックボックスのオン・オフで挿入と削除を切り替える方法が分からず、困っております。

下記にどのうように追記すれば宜しいでしょうか？

どなたか詳しい方がいらっしゃいましたら、ご教授頂ければと思います。
宜しくお願い致します。

Sub チェック3_Click()
Dim myInp As Variant
Dim addCell As Range
Dim chkFlag As Integer
With ThisWorkbook.Worksheets("登録前")
Set addCell = .Range("DZ17").MergeArea

.Ovals.Add Left:=addCell.Left, _
Top:=addCell.Top, _
Width:=addCell.Width, _
Height:=addCell.Height
End With
End Sub

質問者からの補足コメント

• 

  ご回答とご提案ありがとうございます。
  「見える」・「見えない」とする場合は、どのようなマクロを組めば宜しいのでしょうか。。。
  当方あまりＶＢＡに詳しくなく、お手数でなければご教授頂ければと思います。

  No.1の回答に寄せられた補足コメントです。 補足日時：2016/09/26 18:15

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2016/09/26 19:14

#2の回答者です。

　objName = Application.Caller
ここで取得していますから、
>If .CheckBoxes("Macro1").Value = xlOn Then
"Macro1" は不要です。あえて入れるなら、チェックボックスの名称です。

　If .CheckBoxes(objName).Value = xlOn Then
のままで結構です。

この部分がないと、自分自身のチェックボタンのオン/オフが取れませんね。

それと、まっさらのシートでやってみましたが、うまく行きません。
よく見てみると、
Left:=addCell.Left

どうやら、ここの部分で、はみ出てしまうようですね。

だから、
　 Left:=addCell.Left +1

+1を足してみると良いでしょう。
ついでに、Top も足してみました。

デバッグとして、ステップモード(F8)で、ローカルウィンドウで、中がどのように変化していくか見るのが、コツです。

Sub チェック3_Click()
'名前をつけないで行う　場所を指定して削除
　Dim myInp As Variant
　Dim addCell As Range
　Dim chkFlag As Integer
　Dim objName As Variant
　Dim shp As Object
　objName = Application.Caller
　With ThisWorkbook.Worksheets("登録前")
　　Set addCell = .Range("DZ17").MergeArea
　　If VarType(objName) <> vbString Then Exit Sub
　　If .CheckBoxes(objName).Value = xlOn Then
　　　.Ovals.Add Left:=addCell.Left + 1, _
　　　Top:=addCell.Top + 1, _
　　　Width:=addCell.Width, _
　　　Height:=addCell.Height
　　Else
　　　On Error Resume Next
　　　For Each shp In .Shapes
　　　　If Not Intersect(shp.TopLeftCell, addCell) Is Nothing Then
　　　　　shp.Delete
　　　　End If
　　　Next
　　　On Error GoTo 0
　　End If
　End With
End Sub

'-----------------------
こちらは、ワークシートの左上の四角のName Box で、一旦、楕円/円の図形の名前を、例えば、Oval1 とかしてあげて、名前を入れてあけないといけませんね。

'//
Sub チェック3_Click()
'Visible のオン/オフ
　Dim myInp As Variant
　Dim addCell As Range
　Dim objName As Variant
　Dim shp As Object
　objName = Application.Caller
　With ThisWorkbook.Worksheets("登録前")
　　Set addCell = .Range("DZ17").MergeArea
　　Set shp = .Shapes("Oval1")　'名称*
　　If VarType(objName) <> vbString Then Exit Sub
　　If .CheckBoxes(objName).Value = xlOn Then
　　　　shp.Visible = msoTrue
　　Else
　　　On Error Resume Next
　　　　 shp.Visible = msoFalse
　　　On Error GoTo 0
　　End If
　End With
End Sub


さて、こんなところですが、
>団塊世代の上司に命ぜられ、今日からＶＢＡの勉強を始めたばかりでして。。

って、65歳ぐらいでしょうか。本当は、その世代って、特に、Excelなどは得意としているはずなのですが……。ビル・ゲーツは、それよりも歳下です。しかし、ゲーツは、こういうことは不得意だったりして(笑)。しかし、ゲーツという人は、ビジネスの戦略では家康のように用意周到のようです。

今日からでは、ちょっとレベルが高すぎますね。
だって、この手の内容は、どこにも、もう載っていないはずです。

No.5 回答者： ママチャリ 回答日時： 2016/09/26 21:23

チェックボックスって、ActiveXコントロールですよね？フォームコントロールじゃないですよね？

マクロはチェックボックスのClickイベントプロシジャとして良いのですよね？
であれば、楕円を動的に作成するのではなく、事前に作成しておけば、とっても簡単です。
こんな感じです。

Private Sub チェック_3_Click()
Me.Shapes.Range(Array("円/楕円 1")).Visible = チェック_3.Value
End Sub


"円/楕円 1"のところは、事前に作成した図形の名前にしてください。

No.4 回答者： tom04 回答日時： 2016/09/26 21:02

こんばんは！

横からお邪魔します。

Private Sub チェック3_Click()
Dim myInp As Variant
Dim addCell As Range
Dim chkFlag As Integer
Dim mySp As Shape, wS As Worksheet
Set wS = Worksheets("登録前")
Set addCell = wS.Range("DZ17").MergeArea
If チェック3 = True Then
With wS
.Ovals.Add Left:=addCell.Left, _
Top:=addCell.Top, _
Width:=addCell.Width, _
Height:=addCell.Height
End With
Else
For Each mySp In wS.Shapes
If mySp.AutoShapeType = msoShapeOval Then
If mySp.Top >= addCell.Top And mySp.Left >= addCell.Left Then
If mySp.Height <= addCell.Height And mySp.Width <= addCell.Width Then
mySp.Delete
Exit For
End If
End If
End If
Next mySp
End If
End Sub

※　Excel2010では大丈夫でした。
手元にExcel2003がないので
ちゃんと動かなかったらごめんなさい。m(_ _)m

No.2 回答者： WindFaller 回答日時： 2016/09/26 14:29

考えてみました。

トグルのテクニックなどは、おわかりになっていただけるかと思います。フォームコントロールならではの手法です。

objName = Application.Caller
を使うのが、コツです。

1.　オートシェイプに名前をつけないで実行する方法

Sub チェック3_Click()
'名前をつけないで行う　場所を指定して削除
　Dim myInp As Variant
　Dim addCell As Range
　Dim chkFlag As Integer
　Dim objName As Variant
　Dim shp As Object
　objName = Application.Caller
　With ThisWorkbook.Worksheets("登録前")
　　Set addCell = .Range("DZ17").MergeArea
　　If VarType(objName) <> vbString Then Exit Sub
　　If .CheckBoxes(objName).Value = xlOn Then
　　　.Ovals.Add Left:=addCell.Left, _
　　　Top:=addCell.Top, _
　　　Width:=addCell.Width, _
　　　Height:=addCell.Height
　　Else
　　　On Error Resume Next
　　　For Each shp In .Shapes
　　　　If Not Intersect(shp.TopLeftCell, addCell) Is Nothing Then
　　　　　shp.Delete
　　　　End If
　　　Next
　　　On Error GoTo 0
　　End If
　End With
End Sub


1.　オートシェイプに名前をつけて実行する方法
(最初に、前のオートシェイプは削除していないといけません）

Sub チェック3_Click()
'名前をつけて行う
　Dim myInp As Variant
　Dim addCell As Range
　Dim chkFlag As Integer
　Dim objName As Variant
　objName = Application.Caller
　If VarType(objName) <> vbString Then Exit Sub
　With ThisWorkbook.Worksheets("登録前")
　　If .CheckBoxes(objName).Value = xlOn Then
　　　Set addCell = .Range("DZ17").MergeArea
　　　Set shp = .Ovals.Add(Left:=addCell.Left, _
　　　Top:=addCell.Top, _
　　　Width:=addCell.Width, _
　　　Height:=addCell.Height)
　　　shp.Name = "CheckOval"
　　Else
　　　On Error Resume Next
　　　　.Shapes("CheckOval").Delete
　　　On Error GoTo 0
　　End If
　End With
End Sub

'//

なお、たぶん、環境によると思うのですが、Excel 2003等でオートシェイプ等の削除・追加を繰り返していると、画面が反応しなくなることがあります。論理的には、100万回以上なのですが、千回程度で、上限に達することがあります。この回数はシートに対して累積のようです。問題がなければ、この話は無視して構いませんが、もし何かあれば、#1さんがお書きなった方法を採用していただいたほうがよいかもしれません。

だめになったら、シートを新しくすれば、復活するのですが、そんな人はいませんよね。（^^;

この回答へのお礼

わざわざご記入まで頂き、ありがとうございます。
あまりＶＢＡに詳しくなく、頂いたとおりに入力してみたのですが、「チェックボックスのプロパティエラー」というものが出てしまいます。
If .CheckBoxes("Macro1").Value = xlOn Thenno
のところでエラーが出てしまうのですが、どうすれば良いでしょうか。。。

実は団塊世代の上司に命ぜられ、今日からＶＢＡの勉強を始めたばかりでして。。。

お礼日時：2016/09/26 18:25

No.1 回答者： GooUserラック 回答日時： 2016/09/26 14:12

回答では有りません、提案になります。

「挿入」と「削除」だと楕円の管理が難しいので、「見える（○○.ShapeRange.Line.Visible = msoFalse）」と「見えない（○○.ShapeRange.Line.Visible = msoFalse）」としたほうがいいです。