علاوه بر کدهای استاد گرامی جناب آقای حسن پور
این هم میتونید استفاده کنید
کد PHP:
Option Explicit
Public WithEvents chkbEvents As MSForms.CheckBox
Private Sub UserForm_Initialize()
If UserForms.Count > 1 Then Exit Sub
Call HookCheckBoxes
End Sub
Private Sub UserForm_Terminate()
Call UnloadForms
End Sub
Private Sub chkbEvents_Click()
Dim oCtl As Control
Dim lTotal As Long
For Each oCtl In UserForms(0).Controls
If TypeOf oCtl Is MSForms.CheckBox Then
If oCtl.Value = True Then lTotal = lTotal + 1
UserForms(0).Label170.Caption = "تعداد " & (lTotal) & " نفر"
End If
Next
End Sub
Private Sub HookCheckBoxes()
Dim oCtl As Control
Dim lTotal As Long
Label170.Caption = "تعداد " & (lTotal) & " نفر"
For Each oCtl In Me.Controls
If TypeOf oCtl Is MSForms.CheckBox Then
If oCtl.Value = True Then lTotal = lTotal + 1
CallByName UserForms.Add(Me.Name), "chkbEvents", VbSet, oCtl
End If
Next
Label170.Caption = "تعداد " & (lTotal) & " نفر"
End Sub
Private Sub UnloadForms()
End
End Sub
Private Sub CoB_Sabt_Click()
Dim i As Long
Dim list1 As New Collection
Set list1 = Nothing
Range("E3:G30").ClearContents
'تعداد چک باکس ها
For i = 1 To 105
If Me.Controls("CheckBox" & i) = True Then
list1.Add Me.Controls("CheckBox" & i).Caption
End If
Next
If list1.Count > 0 Then
For i = 1 To list1.Count
If i <= 24 Then
Range("E" & i + 2) = list1.Item(i)
Else
Range("f" & i + 2 - 16) = list1.Item(i)
End If
Next
' Cells(3, 32).Value = TextBox03.Value
MsgBox "اطلاعات با موفقيت ثبت شد", vbMsgBoxRight, "ثبت اطلاعات"
End If
End Sub
Leave a comment: