【Excel VBA】チェックボックスの有無

Excel2003を使用しています。

昨日、『チェックボックスの挿入位置』で質問させていただきましたが、その続きというか、もうひとつ条件を追加したく、改めて質問させていただきます。

Sheet2のN1セルに入力されている番号と同じ番号が入力されているセルをSheet1のA列(A11:A200)から探して、その行のB列にチェックボックスを挿入したく、下記のようにコードを書いています。

----------------------------------------

Sub test2()
Dim myStr As String
Dim myRange As Range

myStr = Sheets("Sheet2").Range("N1").Value
Set myRange = Sheets("Sheet1").Range("A11:A200").Find(myStr)

If myRange Is Nothing Then
Exit Sub
Else
Sheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=myRange.Offset(, 1).Left , Top:=myRange.Top , Width:=12, Height:=13).Select
End If
End Sub

----------------------------------------

それで、今回追加したい条件は、既に、チェックボックスが挿入されていた場合は、何もせずに処理を終えたいのです。
現在は、チェックボックスが挿入されていると、そのチェックボックスの上に新たに重なってしまいますので、そうならないようにできたらと思い、質問させていただきました。

よろしくお願いします。

No.1 ベストアンサー 回答者： masa_019 回答日時： 2009/03/17 20:00

こんにちは。

ヒントだけですが、
チェックボックスの左上端にあるセルは
以下のようにして調べられます。

Option Explicit

Sub Sample()

Dim c As OLEObject

For Each c In Sheet1.OLEObjects
If c.progID = "Forms.CheckBox.1" Then
Debug.Print c.TopLeftCell.Address
End If
Next

End Sub

例えば、上記のように取得したアドレスを
myRange.Offset(, 1)のアドレスと
比較すれば良いでしょう。

この回答へのお礼

アドバイスありがとうございます。

記載していただいたコードを参考にさせていただきながら、下記のように書いてみましたが、エラーは出ないものの、追加したつもりの条件が反映されません…(>_<)

----------------------------------------

Sub test2()
Dim myStr As String
Dim myRange As Range
Dim c As OLEObject
Dim myAdrs As String

myStr = Sheets("Sheet2").Range("N4").Value
Set myRange = Sheets("Sheet1").Range("A11:A200").Find(myStr)

If myRange Is Nothing Then
Exit Sub
Else
For Each c In Sheets("Sheet1").OLEObjects
If c.progID = "Forms.CheckBox.1" Then
myAdrs = c.TopLeftCell.Address
If myAdrs = myRange.Offset(, 1).Address Then
Exit Sub
Else
Sheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=myRange.Offset(, 1).Left, Top:=myRange.Top, Width:=12, Height:=13).Select
End If
End If
Next
End If
End Sub

----------------------------------------

コードの書き方が間違っているのだと思うのですが、お時間がありましたら、見てくださると助かります。
よろしくお願いします。

お礼日時：2009/03/18 11:17

No.3 回答者： masa_019 回答日時： 2009/03/20 19:19

No.2の回答にサンプル上げてるんですが・・・。

それでうまくいきませんか？
もう見てないかな？

この回答へのお礼

度々、ありがとうございます。

No.2で記載していただいたサンプルを参考に、コードを書き換えて試してみたのですが、うまくいきませんでした…。

再度、見直して試してみることにします。

お礼日時：2009/03/20 22:25

No.2 回答者： masa_019 回答日時： 2009/03/18 19:39

No.1です。

チェックボックスが複数有った場合
変数cがmyRange.Offset(, 1)の上以外のチェックボックスを参照していると
myRange.Offset(, 1)にチェックボックスがあっても
myAdrs = myRange.Offset(, 1).Address　がTrueになりません。
そういうケースの場合にはチェックボックスが追加されてしまいます。
逆にチェックボックスがひとつもない場合はチェックボックスが追加されないですね。
うまくいくのは、myRange.Offset(, 1)にチェックボックスがひとつある場合だけだと思います。

Sub test2()
Dim myStr As String
Dim myRange As Range
Dim c As OLEObject
Dim myAdrs As String

myStr = Sheets("Sheet2").Range("N4").Value
Set myRange = Sheets("Sheet1").Range("A11:A200").Find(myStr)

If myRange Is Nothing Then Exit Sub

For Each c In Sheets("Sheet1").OLEObjects
If c.progID = "Forms.CheckBox.1" Then
myAdrs = c.TopLeftCell.Address

If myAdrs = myRange.Offset(, 1).Address Then Exit Sub


End If
Next

Sheets("Sheet1").OLEObjects.Add ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=myRange.Offset(, 1).Left, Top:=myRange.Top, Width:=12, Height:=13

End Sub

上記のようにすればうまくいくと思います。

この回答へのお礼

再度の回答ありがとうございます。

> うまくいくのは、myRange.Offset(, 1)にチェックボックスがひとつある場合だけだと思います。

チェックボックスはひとつではないので、当初の質問の『チェックボックスが新たに重ならないようにする』というのは、難しそうですね(*_*)

Sheet1でデータ入力→あるマクロを実行→Sheet2に作成されている表に入力したデータが表示されるのですが、そのデータをSheet2の表でプリントアウトしたかどうかをSheet1上のチェックボックスでわかるようにしたかったのです。(Sheet1には入力したデータが残っていますので…)

今回は別の方法でもう少し考えてみることにしますが、masa_019 さんからいただいたアドバイスは大変勉強になりました。
ありがとうございました！

お礼日時：2009/03/19 10:27