Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7008 / 13644 ツリー ←次へ | 前へ→

【41803】チェックボックスのチェック数を数える ひこ 06/8/23(水) 11:00 質問[未読]
【41804】Re:チェックボックスのチェック数を数える Blue 06/8/23(水) 11:04 質問[未読]
【41808】Re:チェックボックスのチェック数を数える ひこ 06/8/23(水) 13:46 発言[未読]
【41809】Re:チェックボックスのチェック数を数える Blue 06/8/23(水) 14:15 回答[未読]
【41811】Re:チェックボックスのチェック数を数える ひこ 06/8/23(水) 14:46 お礼[未読]
【41812】Re:チェックボックスのチェック数を数える Kein 06/8/23(水) 14:52 回答[未読]

【41803】チェックボックスのチェック数を数える
質問  ひこ  - 06/8/23(水) 11:00 -

引用なし
パスワード
   教えてください。 チェックボックスを30個配置しチェックボックスのチェックされた数をセルに表示しようと思っています。
よろしくお願いします。

【41804】Re:チェックボックスのチェック数を数える
質問  Blue  - 06/8/23(水) 11:04 -

引用なし
パスワード
   ▼ひこ さん:
>チェックボックスを30個配置し
どこに配置したチェックボックスでしょうか?

また、シートに配置した場合
そのチェックボックスは、「フォーム」から追加したものなのか、
「コントロールツールボックス」から追加したものなのかどちらでしょうか?

【41808】Re:チェックボックスのチェック数を数える
発言  ひこ  - 06/8/23(水) 13:46 -

引用なし
パスワード
   すみません
コントロールツールボックスからシートのセルA1からA30に貼り付けています。

【41809】Re:チェックボックスのチェック数を数える
回答  Blue  - 06/8/23(水) 14:15 -

引用なし
パスワード
   オブジェクト名が CheckBox1,CheckBox2,・・・・CheckBox30であるならば
簡単です。

  Dim i As Long
  Dim checkNum As Long ' チェック数
  
  For i = 1 To 30
    If OLEObjects("CheckBox" & CStr(i)).Object.Value Then
      checkNum = checkNum + 1
    End If
  Next
  MsgBox checkNum & "個チェックが入っています。"


そうでない場合は、OLEObjectsをループさせて、TopLeftCellプロパティあたりで
確認していく感じでしょうか。

【41811】Re:チェックボックスのチェック数を数える
お礼  ひこ  - 06/8/23(水) 14:46 -

引用なし
パスワード
   Blueさんありがとうございました。
うまくいきました。

【41812】Re:チェックボックスのチェック数を数える
回答  Kein  - 06/8/23(水) 14:52 -

引用なし
パスワード
   コントロールツールボックスのチェックボックスを使うのでなく、
フォームツールバーのチェックボックスに変更して、同様の処理を
した方が効率的かと思います。テストするなら任意の空白シート
を開き、以下の CkBoxes_Add を1回だけ実行して下さい。
チェックをつけた数は C1セル にカウントされます。もちろん
チェックを外したときは、カウントを一つ減らします。
結果がよければ、現在コントロールツールボックスのコントロール
を配置しているシートを開いて、実行してみて下さい。

Sub CkBoxes_Add()
  Dim Obj As OLEObject
  Dim i As Integer
  Dim Tp As Single, Hp As Single
 
  With ActiveSheet
   If .OLEObjects.Count > 0 Then
     For Each Obj In ActiveSheet.OLEObjects
      If Obj.ProgId = "Forms.CheckBox.1" Then
        Obj.Delete
      End If
     Next
   End If
   With .CheckBoxes
     If .Count > 0 Then .Delete
   End With
   For i = 1 To 30
     Tp = .Cells(i, 1).Top
     Hp = .Cells(i, 1).Height
     .CheckBoxes.Add 0, Tp, Hp, Hp
   Next i
   With .CheckBoxes
     .Text = ""
     .OnAction = "Ck_Count"
   End With
  End With
End Sub

Sub Ck_Count()
  Dim x As Variant
  Dim Ck As Long
 
  x = Application.Caller
  If VarType(x) <> 8 Then Exit Sub
  Ck = ActiveSheet.CheckBoxes(x).Value
  With Cells(1, 3)
   If Ck = xlOn Then
     .Value = .Value + 1
   Else
     .Value = .Value - 1
   End If
  End With
End Sub

7008 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free