[[20150216171656]]　『チェックボックスの一括処理』（あき）　ページの最後に飛ぶ

『チェックボックスの一括処理』（あき）

はじめまして、
チェックボックスの処理についてどうしてもできないため、質問させていただきます。

曜日の指定にて下記のチェックボックスを使っています。
※1つのセル内にすべておいています。

□全日
□月　□火　□水　□木　□金　□土　□日

全日を指定した場合、月～日すべてにチェックが入ります。

【現在使用しているマクロ】

Sub チェック1_Click()
ActiveSheet.CheckBoxes(Array(2, 3, 4, 5, 6, 7, 8)).Value = ActiveSheet.CheckBoxes(1).Value
End Sub

これを1つのシート内で複数設置したいのですが、1つ目のもの以外は動いてくれません。
下記の様な表で、会社毎にチェックボックスを設置したい場合にはどのようにすればよろしいのでしょうか？

 ｜　　A　　｜　　　　B　　　　｜　　C　　｜　D　｜
1｜　会社名 ｜チェックボックス ｜ 指定時間｜ 備考｜
2｜　会社名 ｜チェックボックス ｜ 指定時間｜ 備考｜
3｜　会社名 ｜チェックボックス ｜ 指定時間｜ 備考｜
4｜　会社名 ｜チェックボックス ｜ 指定時間｜ 備考｜

皆様お忙しかと思われますが、何卒ご教授ください。
よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 シートにそんなたくさんのオブジェクトは置かないほうがいいと思いますよ。
 メンテナンスしにくいし。

 B列を選択したら、ユーザーフォームを出して、チェックさせて
 内容に応じてB列に値を入れる、としたほうが効率的ではないでしょうか？
 コードも一つで済むし。
（稲葉） 2015/02/16(月) 18:03

稲葉様

ご意見ありがとうございます。
上司のこだわりのようで・・・

チェックボックスでやりたいみたいなのです。
自分に決定権がないので…
（あき） 2015/02/16(月) 18:27

 だって、チェックボックス分イベント用意するようですよ？
 そうじゃなければ
http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P-Ctrl_Arrays.htm
 こちらを読んで、イベントの配列化させる手法学ばないと、100行あれば100イベント作る必要ありますよね？

 代替案で、ユーザーフォームを作成して（UserForm1とする）、以下のようにチェックボックス8つと
 ボタン２つを作る
 □の右にある数字は、作る順番です。
┏━━━━━━━━━━━━━━━━━━━━┓
┃□８　　　　　　　　　　　　　　　　　　┃
┃　　　　　　　　　　　　　　　　　　　　┃
┃□１　□２　□３　□４　□５　□６　□７┃
┃　　　　　　　　　　　　　　　　　　　　┃
┃┌────┐　　　┌────┐　　　　　┃
┃│ボタン１│　　　│ボタン２│　　　　　┃
┃└────┘　　　└────┘　　　　　┃
┗━━━━━━━━━━━━━━━━━━━━┛

 ユーザーフォームのコードに以下を張り付ける
    Private CBs As Collection
    Private Sub UserForm_Initialize()
        Dim i As Long
        Set CBs = New Collection
        With CBs
            .Add Me.CheckBox1, "月"
            .Add Me.CheckBox2, "火"
            .Add Me.CheckBox3, "水"
            .Add Me.CheckBox4, "木"
            .Add Me.CheckBox5, "金"
            .Add Me.CheckBox6, "土"
            .Add Me.CheckBox7, "日"
            .Add Me.CheckBox8, "全"
        End With
        Me.CommandButton1.Caption = "入力"
        Me.CommandButton2.Caption = "キャンセル"
        For i = 1 To 8
            CBs(i).Caption = Mid("月火水木金土日全", i, 1)
        Next i
        SetValue
    End Sub
    Private Sub CommandButton1_Click()
        Selection.Value = GetValue
        Unload Me
    End Sub
    Private Sub CommandButton2_Click()
        Unload Me
    End Sub
    Private Sub CheckBox8_Click()
        Dim i As Long
        Dim flg As Boolean
        flg = CBs("全").Value
        For i = 1 To 7
            CBs(i).Value = flg
        Next i
    End Sub
    Private Function GetValue() As String
        Dim i As Long
        Dim tmp As String
        For i = 1 To 7
            tmp = tmp & IIf(CBs(i).Value, "■", "□") & CBs(i).Caption & " "
        Next i
        GetValue = tmp
    End Function
    Private Function SetValue() As String
        Dim i As Long
        Dim tmp As String
        tmp = Selection.Value
        On Error Resume Next
            For i = 2 To 18 Step 3
                CBs(Mid(tmp, i, 1)).Value = Mid(tmp, i - 1, 1) = "■"
            Next i
        On Error GoTo 0
    End Function

 使いたいシートモジュールに
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Not Target.Address Like "$B$*" Then Exit Sub
        UserForm1.Show
    End Sub
 を張り付ける

 B列を選択すると、ユーザーフォームが立ち上がって、チェックボックスを選択して入力ボタンを
 クリックすると
 □月 ■火 ■水 □木 □金 □土 □日 
 こんな感じで入力されます。

 例の場合、火曜と水曜にチェックが入っていた状態です。

 こちらでどうですか？

（稲葉） 2015/02/16(月) 18:51

 追記
 仮にイベントの配列化ができたとしても、曜日がどの行の曜日なのか取得するには、チェックボックスの
 オブジェクト名称や、オブジェクトの位置情報を基に判断しなければいけないので、かなり煩雑になる
 のではないかと予想しています。

 ichinoseさんなら何とかしてくれそうですが、やっぱり私はお勧めしないなぁ・・・
（稲葉） 2015/02/16(月) 19:04

稲葉様

ありがとうございます。
こちらで作成して一度上司へ提出してみようと思います！

本当にありがとうございました！！
（あき） 2015/02/16(月) 19:27

 最近マイブーム（死語？）のチェックボックスもどき案です。

 標準モジュールで一度下記を実行し、
 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 Sub シート作成()
    Const データ行数 = 7

    Cells.Clear

    Columns("A").ColumnWidth = 16
    Columns("B").ColumnWidth = 6
    Columns("C:I").ColumnWidth = 4
    Columns("J:K").ColumnWidth = 16

    Range("A1").Value = "会社名"
    Range("B1:I1").Merge
    Range("B1").Value = "日付チェック"
    Range("J1").Value = "時刻"
    Range("K1").Value = "備考"

    Cells.Interior.ThemeColor = xlThemeColorDark1
    Range("A1:K1").Interior.ThemeColor = xlThemeColorAccent5
    Range("B2").Resize(データ行数, 1).Interior.Color = 13434879
    Range("H2").Resize(データ行数, 1).Interior.Color = 16772300
    Range("I2").Resize(データ行数, 1).Interior.Color = 16764159

    Range("A1").Resize(データ行数 + 1, 11).Borders.Weight = xlThin
    Range("B1").Resize(データ行数 + 1, 8).Borders(xlInsideVertical).LineStyle = xlNone

    Dim r As Long
    Dim c As Long
    For r = 2 To データ行数 + 1
        Cells(r, "A").Value = "会社名" & Chr(63 + r)
        For c = 0 To 7
            If c = 0 Then
                曜日 = "全日"
            Else
                曜日 = Mid("月火水木金土日", c, 1)
            End If
            Cells(r, 2 + c).NumberFormatLocal = "□" & 曜日 & "[=0];" & ChrW(9745) & 曜日 & "[=1];;"
            Cells(r, 2 + c).Value = 0
        Next
    Next
 End Sub

 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

 表のシートモジュール（シートタブから「コードの表示」）に下記を置きます。
 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge <> 1 Then Exit Sub
    If Intersect(Range("B2:I8"), Target) Is Nothing Then Exit Sub

    Application.EnableEvents = False
    If Target.Column = 2 Then
        Target.Resize(1, 8).Value = IIf(Target.Value = 0, 1, 0)
    Else
        Target.Value = IIf(Target.Value = 0, 1, 0)
    End If
    Cancel = True
    Cells(Target.Row, "A").Select
    Application.EnableEvents = True
 End Sub
 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

 セルの右クリックで操作です。
 セルの値は１と０なので、今回は不要かもしれませんが、集計も可能です。

 シート作成後は「シート作成」マクロは削除しておいたほうが良いかもしれません。
 間違って再実行すると全部消えてしまうので。
 行コピーすれば行数は増やせます。その場合、シートモジュールのマクロの
    If Intersect(Range("B2:I8"), Target) Is Nothing Then Exit Sub
 のクリック範囲（"B2:I8"）を変更してください。
（Mook） 2015/02/16(月) 19:43

 Mookさんの便利ですなぁ！
 実体が0,1なのも計算しやすい！
（稲葉） 2015/02/17(火) 08:49

Mook様

ありがとうございます！
まだ試せておりませんが、後程ゆっくり拝見させていただきたいです！

稲葉様

昨日は本当にありがとうござました！上司かGOサインが出ました！
ただ、他のセルにも使いたいといわれたので、編集してみたのですが、どうにもうまくいきません。
安易に変更したのがだめだったのでしょうか？
昨日のものにプラスしPの部分をユーザーフォームを作成してUserForm2として作業いたしました。

 ｜　　A　～｜～　　　O　　　　｜　　　　P　　　　｜　　　　　Q　　　｜　　R　 ｜
1｜　会社名 ｜チェックボックス ｜チェックボックス ｜チェックボックス ｜  備考　｜
2｜　会社名 ｜チェックボックス ｜チェックボックス ｜チェックボックス ｜  備考　｜
3｜　会社名 ｜チェックボックス ｜チェックボックス ｜チェックボックス ｜  備考　｜
4｜　会社名 ｜チェックボックス ｜チェックボックス ｜チェックボックス ｜  備考　｜

   Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Not Target.Address Like "$O$*" Then Exit Sub
        UserForm1.Show
    End Sub
   Private Sub Worksheet_SelectionChange2(ByVal Target As Range)
        If Not Target.Address Like "$P$*" Then Exit Sub
        UserForm2.Show
    End Sub
   Private Sub Worksheet_SelectionChange3(ByVal Target As Range)
        If Not Target.Address Like "$Q$*" Then Exit Sub
        UserForm3.Show
    End Sub

 Private CBs As Collection

Private Sub CheckBox2_Click()

End Sub

Private Sub CheckBox3_Click()

End Sub

Private Sub CheckBox4_Click()

End Sub

    Private Sub UserForm_Initialize()
        Dim i As Long
        Set CBs = New Collection
        With CBs
            .Add Me.CheckBox1, "午前"
            .Add Me.CheckBox2, "午後"
            .Add Me.CheckBox3, "夜間"
            .Add Me.CheckBox4, "早朝"
            .Add Me.CheckBox5, "全"
        End With
        Me.CommandButton1.Caption = "入力"
        Me.CommandButton2.Caption = "キャンセル"
        For i = 1 To 5
            CBs(i).Caption = Mid("午前午後夜間早朝全", i, 1)
        Next i
        SetValue
    End Sub
    Private Sub CommandButton1_Click()
        Selection.Value = GetValue
        Unload Me
    End Sub
    Private Sub CommandButton2_Click()
        Unload Me
    End Sub
    Private Sub CheckBox5_Click()
        Dim i As Long
        Dim flg As Boolean
        flg = CBs("全").Value
        For i = 1 To 4
            CBs(i).Value = flg
        Next i
    End Sub
    Private Function GetValue() As String
        Dim i As Long
        Dim tmp As String
        For i = 1 To 4
            tmp = tmp & IIf(CBs(i).Value, "■", "□") & CBs(i).Caption & " "
        Next i
        GetValue = tmp
    End Function
    Private Function SetValue() As String
        Dim i As Long
        Dim tmp As String
        tmp = Selection.Value
        On Error Resume Next
            For i = 2 To 18 Step 3
                CBs(Mid(tmp, i, 1)).Value = Mid(tmp, i - 1, 1) = "■"
            Next i
        On Error GoTo 0
    End Function

お忙しいかと存じますが、再度ご教授いただけましたら嬉しいです。
（あき） 2015/02/17(火) 11:55

 稲葉さんが回答を書いているとは思いますが、とりあえずイベント部分だけ、
 SelectionChange は固定のものなので、SelectionChange2、SelectionChange3 などは出来ません。

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Target.Address Like "$O$*" Then UserForm1.Show
        If Target.Address Like "$P$*" Then UserForm2.Show
        If Target.Address Like "$Q$*" Then UserForm3.Show
    End Sub
 のようにしたら、とりあえずユーザフォームは起動しないでしょうか。
（Mook） 2015/02/17(火) 12:04

 今書いてましたー。

 イベントについてはMookさんの言う通りです！

 ＞Mid("午前午後夜間早朝全", i, 1)
 こういうところとか癖がある書き方したのでわかりにくかったですよね。

 これは調べてやれって言うのは酷だと思いますのでもう少し情報と時間ください。
 コードと説明書きを作ります。

 質問
 １）ユーザーフォーム分けるの面倒なので、一つのユーザーフォームでOPQ列（B列はただの例だったのかな？）
 　　をいじってもよろしいですか？

 ２）O列は昨日の曜日、
 　　P列は「午前　午後　夜間　早朝　全」として
 　　Q列はどうなりますか？
（稲葉） 2015/02/17(火) 12:08

Mook様

なるほど固定なのですね。
そちらの形にしたら確かに起動いたしました！
ちょっと面白い形になってしまいましたが（汗）

稲葉様

最初はそちらだったのですが、後から後から出てまいりましたorz
お手間を取らせてしますいません。
説明書きとても助かります！

一つのユーザーフォームでも問題ございません。
逆にいろいろな場所を触らせるよりわかりやすいかもしれません。

Qは『月初、中旬、月末』です。

何卒よろしくお願いします！

（あき） 2015/02/17(火) 13:13

 こちらも聞き忘れましたが、曜日はともかく、
 時間と月に関しては、チェックボックスではなくラジオボタンのほうが適していると思うのですが・・・

（稲葉） 2015/02/17(火) 13:22

稲葉様

複数選択をする可能性がある為チェックボックス仕様にしております。
各会社ごとにヒアリングした結果をメモしていく形のようです。

私も自分が使っているのではないので詳しくわからないのですが…。

（あき） 2015/02/17(火) 13:32

 遅くなりました。
 休憩時間に作業してたんで済みません。

 ユーザーフォームを以下のように配置してください。
 □がチェックボックスです。
 （図がずれていたら、等幅フォントのメモ帳などで張り付けてみてください・・・）
 ユーザーフォームの名称は、UserForm1　です。
┏━━━━━━━━━━━━━━━━━━━━┓
┃□８　　　　　　　　　　　　　　　　　　┃
┃□１　□２　□３　□４　□５　□６　□７┃
┃　　　　　　　　　　　　　　　　　　　　┃
┃□13　　　　　　　　　　　　　　　　　　┃
┃□９　　　　□10　　　□11　　　　□12　┃
┃　　　　　　　　　　　　　　　　　　　　┃
┃□14　　　　□15　　　□16　　　　　　　┃
┃　　　　　　　　　　　　　　　　　　　　┃
┃┌────┐　　　┌────┐　　　　　┃
┃│ボタン１│　　　│ボタン２│　　　　　┃
┃└────┘　　　└────┘　　　　　┃
┗━━━━━━━━━━━━━━━━━━━━┛
 UserForm1のモジュールに以下を張り付けてください。
Option Explicit

    Private WCBs As Collection '曜日チェックボックス
    Private TCBs As Collection '時間チェックボックス
    Private MCBs As Collection '月チェックボックス
    Private rng  As Range      '入力範囲の設定

    '■立ち上げ時の処理
    Private Sub UserForm_Initialize()
        Dim i As Long
        Set WCBs = New Collection
        Set TCBs = New Collection
        Set MCBs = New Collection

        '曜日のチェックボックス群
        'EvSet関数を使って、チェックボックスをclsGetChkExに登録し、コレクションに加える
        '1つ目の引数がコントロールオブジェクト
        '2つ目がCollectionのKeyにあたる値
        '3つ目がどのコレクションに入れるか分岐するための数値
        '中身は、★印のFunctionを参照
        EvSet Me.CheckBox1, "月", 1
        EvSet Me.CheckBox2, "火", 1
        EvSet Me.CheckBox3, "水", 1
        EvSet Me.CheckBox4, "木", 1
        EvSet Me.CheckBox5, "金", 1
        EvSet Me.CheckBox6, "土", 1
        EvSet Me.CheckBox7, "日", 1
        EvSet Me.CheckBox8, "全曜日", 1
        For i = 1 To 8
            WCBs(i).Caption = Split(",月,火,水,木,金,土,日,全曜日", ",")(i)
        Next i
            '↑Mid関数からSplit関数に変更。
            'Split関数は、区切り文字で区切った0からの配列を変える関数
            '例では{"",月,火,水,木,金,土,日,全曜日}このような配列を返す
            '配列は0から始まるので、1から始まる繰り返し処理のために、ダミーで配列0に""を当てている

        '時間のチェックボックス群
        EvSet Me.CheckBox9, "午前", 2
        EvSet Me.CheckBox10, "午後", 2
        EvSet Me.CheckBox11, "深夜", 2
        EvSet Me.CheckBox12, "早朝", 2
        EvSet Me.CheckBox13, "全日", 2
        For i = 1 To 5
            TCBs(i).Caption = Split(",午前,午後,深夜,早朝,全日", ",")(i)
        Next i

        '月のチェックボックス群
        EvSet Me.CheckBox14, "月初", 3
        EvSet Me.CheckBox15, "中旬", 3
        EvSet Me.CheckBox16, "月末", 3
        For i = 1 To 3
            MCBs(i).Caption = Split(",月初,中旬,月末", ",")(i)
        Next i
        Me.CommandButton1.Caption = "入力"
        Me.CommandButton2.Caption = "キャンセル"
        Set rng = Range("O" & Selection.Row).Resize(, 3)
        SetValue  '▼参照
    End Sub

    '★クラスにチェックボックスを登録する関数
    Function EvSet(ByRef chk As MSForms.CheckBox, ByVal Key As String, ByVal col As Long)
        'クラスにチェックボックスを登録して、イベントをクラスに渡すようにする
        Dim ev As clsGetChkEv
        Set ev = New clsGetChkEv
        Set ev.chkbox = chk
        Select Case col
            Case 1: WCBs.Add ev, Key
            Case 2: TCBs.Add ev, Key
            Case 3: MCBs.Add ev, Key
        End Select
    End Function

    '▲クラスのクリックイベントから実行されるプロシージャ
    Public Sub ChkClick(ByVal Cap As String)
        'クラスのイベントから、押されたボタンのCaption情報のみを取得して、条件を分岐させる
        Dim i As Long
        Select Case Cap
            Case "全曜日"
                For i = 1 To 8
                    WCBs(i).Value = WCBs(Cap).Value
                Next i
            Case "全日"
                For i = 1 To 4
                    TCBs(i).Value = TCBs(Cap).Value
                Next i
        End Select
    End Sub

    '■入力ボタンクリック
    Private Sub CommandButton1_Click()
        rng.Value = GetValue '●参照
        Unload Me
    End Sub

    '■キャンセルボタンクリック
    Private Sub CommandButton2_Click()
        Unload Me
    End Sub

    '●入力ボタンクリック時、コレクションからデータを取得して、配列にする
    Private Function GetValue() As Variant
        '各列でマーク等の設定する可能性があるので、3つの処理に分割
        Dim i As Long
        Dim tmp(1 To 3) As String
        '曜日
        With WCBs
            For i = 1 To WCBs.Count - 1 '全を除く
                tmp(1) = tmp(1) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With

        '時間帯
        With TCBs
            For i = 1 To TCBs.Count - 1 '全を除く
                tmp(2) = tmp(2) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With

        '月
        With MCBs
            For i = 1 To MCBs.Count '全がないのでそのまま
                tmp(3) = tmp(3) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With
        GetValue = tmp
    End Function

    '▼フォームを立ち上げたときに、各コントロールにデータを入れるサブプロシージャ
    Private Sub SetValue()
        Dim x
        On Error Resume Next
            '曜日
            With WCBs
                For Each x In Split(rng(1, 1).Value, " ")  '←半角の空白で区切って配列にしている
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                    '                        ~~~~~~~~~~~~~~~~~
                    '                        =で繋ぐことで、直接True,Flaseを設定している
                Next x
            End With

            '時間帯
            With TCBs
                For Each x In Split(rng(1, 2).Value, " ")
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                Next x
            End With

            '月
            With MCBs
                For Each x In Split(rng(1, 3).Value, " ")
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                Next x
            End With
        On Error GoTo 0
    End Sub

 ┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐

 次に、クラスモジュールを挿入してオブジェクト名を「clsGetChkEv」としてください。
 クラスモジュールの中に以下のコードを入れてください。
    'clsGetChkEv　というオブジェクト名にしてください。
    Public WithEvents chkbox As MSForms.CheckBox

    '▲クリックされたら、ユーザーフォームのプロシージャを実行する
    '（ユーザーフォームの▲参照）
    Sub chkbox_click()
        UserForm1.ChkClick (chkbox.Caption)
    End Sub

    '↓のプロパティを作らないと、呼び出し先で面倒
    '例）WCBs(1).chkbox.Value ←めんどくさい　｜　WCBs(1).Value　←これなら楽
    'Valueプロパティ
    Public Property Get Value() As Boolean
        Value = chkbox.Value
    End Property
    Public Property Let Value(ByVal Val As Boolean)
        chkbox.Value = Val
    End Property

    'Captionプロパティ
    Public Property Get Caption() As String
        Caption = chkbox.Caption
    End Property
    Public Property Let Caption(ByVal Cap As String)
        chkbox.Caption = Cap
    End Property

 ┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐┐
 次に実際に使用するシートのモジュールに以下のコードを入れてください。
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Target.Rows.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("O:Q")) Is Nothing Then
            UserForm1.Show
        End If
    End Sub

 これでO:Q列を選択すると、ユーザーフォームで入力したデータをテキストとして
 出力できます。

（稲葉） 2015/02/17(火) 16:09

稲葉様

ありがとうございます！！
貴重な休憩中にすいません。
そして月にも全表示が必要でした・・・。

クラスモジュールを作り下記のようにいたしました。

 Sub clsGetChkEv()
         Public WithEvents chkbox As MSForms.CheckBox

    '▲クリックされたら、ユーザーフォームのプロシージャを実行する
    '（ユーザーフォームの▲参照）
    Sub chkbox_click()
        UserForm1.ChkClick (chkbox.Caption)
    End Sub

 '↓のプロパティを作らないと、呼び出し先で面倒
    '例）WCBs(1).chkbox.Value ←めんどくさい　｜　WCBs(1).Value　←これなら楽
    'Valueプロパティ
    Public Property Get Value() As Boolean
        Value = chkbox.Value
    End Property
    Public Property Let Value(ByVal Val As Boolean)
        chkbox.Value = Val
    End Property

    'Captionプロパティ
    Public Property Get Caption() As String
        Caption = chkbox.Caption
    End Property
    Public Property Let Caption(ByVal Cap As String)
        chkbox.Caption = Cap
    End Property

～～～～～～～
全月が必要だったため下記のように追加いたしました。

Option Explicit

    Private WCBs As Collection '曜日チェックボックス
    Private TCBs As Collection '時間チェックボックス
    Private MCBs As Collection '月チェックボックス
    Private rng  As Range      '入力範囲の設定

    '■立ち上げ時の処理
    Private Sub UserForm_Initialize()
        Dim i As Long
        Set WCBs = New Collection
        Set TCBs = New Collection
        Set MCBs = New Collection

        '曜日のチェックボックス群
        'EvSet関数を使って、チェックボックスをclsGetChkExに登録し、コレクションに加える
        '1つ目の引数がコントロールオブジェクト
        '2つ目がCollectionのKeyにあたる値
        '3つ目がどのコレクションに入れるか分岐するための数値
        '中身は、★印のFunctionを参照
        EvSet Me.CheckBox1, "月", 1
        EvSet Me.CheckBox2, "火", 1
        EvSet Me.CheckBox3, "水", 1
        EvSet Me.CheckBox4, "木", 1
        EvSet Me.CheckBox5, "金", 1
        EvSet Me.CheckBox6, "土", 1
        EvSet Me.CheckBox7, "日", 1
        EvSet Me.CheckBox8, "全曜日", 1
        For i = 1 To 8
            WCBs(i).Caption = Split(",月,火,水,木,金,土,日,全曜日", ",")(i)
        Next i
            '↑Mid関数からSplit関数に変更。
            'Split関数は、区切り文字で区切った0からの配列を変える関数
            '例では{"",月,火,水,木,金,土,日,全曜日}このような配列を返す
            '配列は0から始まるので、1から始まる繰り返し処理のために、ダミーで配列0に""を当てている

        '時間のチェックボックス群
        EvSet Me.CheckBox9, "午前", 2
        EvSet Me.CheckBox10, "午後", 2
        EvSet Me.CheckBox11, "深夜", 2
        EvSet Me.CheckBox12, "早朝", 2
        EvSet Me.CheckBox13, "全日", 2
        For i = 1 To 5
            TCBs(i).Caption = Split(",午前,午後,深夜,早朝,全日", ",")(i)
        Next i

        '月のチェックボックス群
        EvSet Me.CheckBox14, "月初", 3
        EvSet Me.CheckBox15, "中旬", 3
        EvSet Me.CheckBox16, "月末", 3
        EvSet Me.CheckBox16, "全月", 3
        For i = 1 To 4
            MCBs(i).Caption = Split(",月初,中旬,月末,全月", ",")(i)
        Next i
        Me.CommandButton1.Caption = "入力"
        Me.CommandButton2.Caption = "キャンセル"
        Set rng = Range("O" & Selection.Row).Resize(, 3)
        SetValue  '▼参照
    End Sub

    '★クラスにチェックボックスを登録する関数
    Function EvSet(ByRef chk As MSForms.CheckBox, ByVal Key As String, ByVal col As Long)
        'クラスにチェックボックスを登録して、イベントをクラスに渡すようにする
        Dim ev As clsGetChkEv
        Set ev = New clsGetChkEv
        Set ev.chkbox = chk
        Select Case col
            Case 1: WCBs.Add ev, Key
            Case 2: TCBs.Add ev, Key
            Case 3: MCBs.Add ev, Key
        End Select
    End Function

    '▲クラスのクリックイベントから実行されるプロシージャ
    Public Sub ChkClick(ByVal Cap As String)
        'クラスのイベントから、押されたボタンのCaption情報のみを取得して、条件を分岐させる
        Dim i As Long
        Select Case Cap
            Case "全曜日"
                For i = 1 To 8
                    WCBs(i).Value = WCBs(Cap).Value
                Next i
            Case "全日"
                For i = 1 To 4
                    TCBs(i).Value = TCBs(Cap).Value
                Next
             Case "全月"
                For i = 1 To 3
                    TCBs(i).Value = MCBs(Cap).Value
                Next i
        End Select
    End Sub

    '■入力ボタンクリック
    Private Sub CommandButton1_Click()
        rng.Value = GetValue '●参照
        Unload Me
    End Sub

    '■キャンセルボタンクリック
    Private Sub CommandButton2_Click()
        Unload Me
    End Sub

    '●入力ボタンクリック時、コレクションからデータを取得して、配列にする
    Private Function GetValue() As Variant
        '各列でマーク等の設定する可能性があるので、3つの処理に分割
        Dim i As Long
        Dim tmp(1 To 3) As String
        '曜日
        With WCBs
            For i = 1 To WCBs.Count - 1 '全を除く
                tmp(1) = tmp(1) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With

        '時間帯
        With TCBs
            For i = 1 To TCBs.Count - 1 '全を除く
                tmp(2) = tmp(2) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With

        '月
        With MCBs
            For i = 1 To MCBs.Count - 1 '全を除く
                tmp(3) = tmp(3) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With
        GetValue = tmp
    End Function

    '▼フォームを立ち上げたときに、各コントロールにデータを入れるサブプロシージャ
    Private Sub SetValue()
        Dim x
        On Error Resume Next
            '曜日
            With WCBs
                For Each x In Split(rng(1, 1).Value, " ")  '←半角の空白で区切って配列にしている
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                    '                        ~~~~~~~~~~~~~~~~~
                    '                        =で繋ぐことで、直接True,Flaseを設定している
                Next x
            End With

            '時間帯
            With TCBs
                For Each x In Split(rng(1, 2).Value, " ")
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                Next x
            End With

            '月
            With MCBs
                For Each x In Split(rng(1, 3).Value, " ")
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                Next x
            End With

        On Error GoTo 0
    End Sub

～～～～
以上で実行してみたのですがどこをクリックしても作動しなくなってしまいました。。。

（あき） 2015/02/17(火) 18:12

稲葉様
すいません！
オブジェクト名を変更し下記のように修正したところちゃんと動きました！
お騒がせしたすいません！

本当にありがとうございます！

Option Explicit

    Private WCBs As Collection '曜日チェックボックス
    Private TCBs As Collection '時間チェックボックス
    Private MCBs As Collection '月チェックボックス
    Private rng  As Range      '入力範囲の設定

Private Sub CheckBox10_Click()

End Sub

Private Sub CheckBox11_Click()

End Sub

Private Sub CheckBox12_Click()

End Sub

Private Sub CheckBox13_Click()

End Sub

Private Sub CheckBox14_Click()

End Sub

Private Sub CheckBox15_Click()

End Sub

Private Sub CheckBox16_Click()

End Sub

Private Sub CheckBox17_Click()

End Sub

Private Sub CheckBox9_Click()

End Sub

    '■立ち上げ時の処理
    Private Sub UserForm_Initialize()
        Dim i As Long
        Set WCBs = New Collection
        Set TCBs = New Collection
        Set MCBs = New Collection

        '曜日のチェックボックス群
        'EvSet関数を使って、チェックボックスをclsGetChkExに登録し、コレクションに加える
        '1つ目の引数がコントロールオブジェクト
        '2つ目がCollectionのKeyにあたる値
        '3つ目がどのコレクションに入れるか分岐するための数値
        '中身は、★印のFunctionを参照
        EvSet Me.CheckBox1, "月", 1
        EvSet Me.CheckBox2, "火", 1
        EvSet Me.CheckBox3, "水", 1
        EvSet Me.CheckBox4, "木", 1
        EvSet Me.CheckBox5, "金", 1
        EvSet Me.CheckBox6, "土", 1
        EvSet Me.CheckBox7, "日", 1
        EvSet Me.CheckBox8, "全曜日", 1
        For i = 1 To 8
            WCBs(i).Caption = Split(",月,火,水,木,金,土,日,全曜日", ",")(i)
        Next i
            '↑Mid関数からSplit関数に変更。
            'Split関数は、区切り文字で区切った0からの配列を変える関数
            '例では{"",月,火,水,木,金,土,日,全曜日}このような配列を返す
            '配列は0から始まるので、1から始まる繰り返し処理のために、ダミーで配列0に""を当てている

        '時間のチェックボックス群
        EvSet Me.CheckBox9, "午前", 2
        EvSet Me.CheckBox10, "午後", 2
        EvSet Me.CheckBox11, "深夜", 2
        EvSet Me.CheckBox12, "早朝", 2
        EvSet Me.CheckBox13, "全日", 2
        For i = 1 To 5
            TCBs(i).Caption = Split(",午前,午後,深夜,早朝,全日", ",")(i)
        Next i

        '月のチェックボックス群
        EvSet Me.CheckBox14, "月初", 3
        EvSet Me.CheckBox15, "中旬", 3
        EvSet Me.CheckBox16, "月末", 3
        EvSet Me.CheckBox17, "全月", 3
        For i = 1 To 4
            MCBs(i).Caption = Split(",月初,中旬,月末,全月", ",")(i)
        Next i
        Me.CommandButton1.Caption = "入力"
        Me.CommandButton2.Caption = "キャンセル"
        Set rng = Range("O" & Selection.Row).Resize(, 3)
        SetValue  '▼参照
    End Sub

    '★クラスにチェックボックスを登録する関数
    Function EvSet(ByRef chk As MSForms.CheckBox, ByVal Key As String, ByVal col As Long)
        'クラスにチェックボックスを登録して、イベントをクラスに渡すようにする
        Dim ev As clsGetChkEv
        Set ev = New clsGetChkEv
        Set ev.chkbox = chk
        Select Case col
            Case 1: WCBs.Add ev, Key
            Case 2: TCBs.Add ev, Key
            Case 3: MCBs.Add ev, Key
        End Select
    End Function

    '▲クラスのクリックイベントから実行されるプロシージャ
    Public Sub ChkClick(ByVal Cap As String)
        'クラスのイベントから、押されたボタンのCaption情報のみを取得して、条件を分岐させる
        Dim i As Long
        Select Case Cap
            Case "全曜日"
                For i = 1 To 8
                    WCBs(i).Value = WCBs(Cap).Value
                Next i
            Case "全日"
                For i = 1 To 4
                    TCBs(i).Value = TCBs(Cap).Value
                Next
             Case "全月"
                For i = 1 To 3
                    MCBs(i).Value = MCBs(Cap).Value
                Next i
        End Select
    End Sub

    '■入力ボタンクリック
    Private Sub CommandButton1_Click()
        rng.Value = GetValue '●参照
        Unload Me
    End Sub

    '■キャンセルボタンクリック
    Private Sub CommandButton2_Click()
        Unload Me
    End Sub

    '●入力ボタンクリック時、コレクションからデータを取得して、配列にする
    Private Function GetValue() As Variant
        '各列でマーク等の設定する可能性があるので、3つの処理に分割
        Dim i As Long
        Dim tmp(1 To 3) As String
        '曜日
        With WCBs
            For i = 1 To WCBs.Count - 1 '全を除く
                tmp(1) = tmp(1) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With

        '時間帯
        With TCBs
            For i = 1 To TCBs.Count - 1 '全を除く
                tmp(2) = tmp(2) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With

        '月
        With MCBs
            For i = 1 To MCBs.Count - 1 '全を除く
                tmp(3) = tmp(3) & IIf(.Item(i).Value, "■", "□") & .Item(i).Caption & " "
            Next i
        End With
        GetValue = tmp
    End Function

    '▼フォームを立ち上げたときに、各コントロールにデータを入れるサブプロシージャ
    Private Sub SetValue()
        Dim x
        On Error Resume Next
            '曜日
            With WCBs
                For Each x In Split(rng(1, 1).Value, " ")  '←半角の空白で区切って配列にしている
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                    '                        ~~~~~~~~~~~~~~~~~
                    '                        =で繋ぐことで、直接True,Flaseを設定している
                Next x
            End With

            '時間帯
            With TCBs
                For Each x In Split(rng(1, 2).Value, " ")
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                Next x
            End With

            '月
            With MCBs
                For Each x In Split(rng(1, 3).Value, " ")
                    .Item(Mid(x, 2)).Value = Left(x, 1) = "■"
                Next x
            End With

        On Error GoTo 0
    End Sub

（あき） 2015/02/17(火) 18:51

コメント返信：

[ 一覧(最新更新順) ]

[[20150216171656]] 『チェックボックスの一括処理』（あき） ページの最後に飛ぶ

[[20150216171656]]　『チェックボックスの一括処理』（あき）　ページの最後に飛ぶ