ワークシート上のチェックボックスのチェックをカウント

質問

こんにちは
EXCELのVBAに関する質問なのですが

ワークシート上に配置したチェックボックス(コントロールツールボックス)
で各シートのCheckbox1にチェックが入っている数を数えたいのですが
下記のように書いたところエラーが出ました。
何かよい改善案ご存知の方いらっしゃいませんか？
よろしくお願いいたします。

Sub test()
Dim myst As Worksheet
Dim yes As Integer, myct As Integer

myct = ThisWorkbook.Sheets.Count
Worksheets.Add after:=Sheets(myct)
Sheets(myct + 1).Name = "syuukei"

For Each myst In Worksheets
On Error GoTo elabel
If ThisWorkbook.myst.CheckBox1.Value = True Then
yes = yes + 1
End If
elabel:
Next
with worksheets("syuukei")
.range("a2")="YESの合計"
.range("b2")=yes
end with
End Sub

回答No.4

1050 円（@1050YEN） · ベストアンサー

エラー処理は、深く考えておりません。
流用しやすいように、大まかな必要そうな情報の収集方法も載せておきます。

Sub test()
　　Call 集計(ThisWorkbook)
End Sub

Sub 集計(p_xlsBook As Workbook)
　　Dim l_xls集計シート As Excel.Worksheet
　　Dim l_xlsSheet　　　As Excel.Worksheet
　　Dim l_lng数_ChkBox　As Long
　　Dim l_lng数_ChkOn　 As Long

　　Set l_xls集計シート = 集計シート取得(p_xlsBook)

　　For Each l_xlsSheet In p_xlsBook.Worksheets
　　　　If Not (l_xls集計シート Is l_xlsSheet) Then
　　　　　　Call 集計_チェックボックス(l_xlsSheet, l_lng数_ChkBox, l_lng数_ChkOn)
　　　　End If
　　Next

　　l_xls集計シート.Range("A2") = "YESの合計"
　　l_xls集計シート.Range("B2") = l_lng数_ChkOn
　　l_xls集計シート.Range("A3") = "CHEKBOXの合計"
　　l_xls集計シート.Range("B3") = l_lng数_ChkBox
　　l_xls集計シート.Select
End Sub

Private Function 集計_チェックボックス( _
　　ByVal p_xlsSheet As Excel.Worksheet, _
　　Optional ByRef p_lng数_ChkBox As Long, _
　　Optional ByRef p_lng数_ChkOn As Long _
) As Long
　　Dim l_objOLE　　　　As OLEObject
　　Dim l_objChkBox　　 As MSForms.CheckBox

　　'OLEオブジェクトでのループ
　　For Each l_objOLE In p_xlsSheet.OLEObjects
　　　　'チェックボックスの判断
　　　　If TypeOf l_objOLE.Object Is MSForms.CheckBox Then
　　　　　　'チェックボックス数をカウントアップ
　　　　　　p_lng数_ChkBox = p_lng数_ChkBox + 1

　　　　　　'MSForms.CheckBox型変数へのキャスト
　　　　　　Set l_objChkBox = l_objOLE.Object
　　　　　　'ON/OFF判定
　　　　　　If l_objChkBox.Value Then
　　　　　　　　'チェックボックスON数をカウントアップ
　　　　　　　　p_lng数_ChkOn = p_lng数_ChkOn + 1
　　　　　　End If
　　　　End If
　　Next
End Function

Private Function 集計シート取得(p_xlsBook As Excel.Workbook) As Excel.Worksheet
　　Const DEFSTR_集計　 As String = "syuukei"
　　Dim l_xlsSheet　　　As Excel.Worksheet

　　If シート存在チェック(p_xlsBook, DEFSTR_集計) Then
　　　　Set l_xlsSheet = p_xlsBook.Worksheets(DEFSTR_集計)
　　Else
　　　　'シートを最後尾に追加
　　　　With p_xlsBook
　　　　　　Set l_xlsSheet = .Worksheets.Add(, .Worksheets(.Worksheets.Count))
　　　　End With
　　　　l_xlsSheet.Name = DEFSTR_集計
　　End If

　　Set 集計シート取得 = l_xlsSheet
End Function

Private Function シート存在チェック(p_xlsBook As Workbook, p_strシート名 As String) As Boolean
　　On Error Resume Next
　　Dim l_xlsSheet　 As Excel.Worksheet
　　Set l_xlsSheet = p_xlsBook.Worksheets(p_strシート名)
　　シート存在チェック = Not l_xlsSheet Is Nothing
　　On Error GoTo 0
End Function

お礼

1050YENさんはじめまして

ご回答ありがとうございます！
・・・というより感動してしまいました。
コメントを書いていただいたり
インデントも整えていただいたり
非常にわかりやすいです。
本当は20P以上差し上げたいです。

以前はVBAよく使っていたのですが
最近はやっていなくて
久しぶりに使ってみたら
鈍っていました。
これから、VBAを再び使うことがあると思います。
もしまた質問することがあったら、
そのときは是非よろしくお願いいたします。

それからシート存在チェック関数というのも
便利ですね。
どこかで使わさせていただきます。(笑)

回答No.3

papayuka

#2です。
ちょっと勘違いしてました。
CheckBox1だけを数えたいなら、#2の　If TypeName(ch.Object) = "CheckBox" Then　を

If ch.Name = "CheckBox1" Then

にすれば良いかと思います。

お礼

papayukaさん、はじめまして

おかげさまで、成功しました。
なぜエラーが出ないのか、さらに自分で考えてみたいと思います。
ありがとうございました。

これからもよろしくお願いいたします。

回答No.2

papayuka

こんな感じでしょうか？

Sub Test1()
Dim ws As Worksheet, ch As OLEObject, cnt As Integer
　cnt = 0
　For Each ws In Worksheets
　　For Each ch In ws.OLEObjects
　　　If TypeName(ch.Object) = "CheckBox" Then
　　　　 If ch.Object.Value Then cnt = cnt + 1
　　　End If
　　Next ch
　Next ws
　Set ws = Worksheets.Add(before:=Worksheets(1))
　On Error Resume Next
　ws.Name = "syuukei"
　ws.Range("A2").Value = "YESの合計"
　ws.Range("B2").Value = cnt
End Sub

回答No.1

imogasi

>For Each myst In Worksheets
For Each myst In Activeworkbook.Worksheets
でどうでしょうか。

お礼

>imogasiさんはじめまして

失礼しました。
前にもお世話になりましたね。
気をつけます。

補足

imogasiさんはじめまして
ごめんなさい、同じエラーが出ました。