[已解决]求教：复选框的复制

c888 · 发表于 2012-11-13 13:12

复选框的复制.rar (9.39 KB, 下载次数: 5)

c888 · 发表于 2012-11-13 13:53

Book1.rar (6.38 KB, 下载次数: 3)

爱疯 · 发表于 2012-11-13 14:48

Private Sub CommandButton1_Click()
Dim ctl As Control
Dim arr()

With Me
      ReDim arr(1 To .Controls.Count, 1 To 1)
      For Each ctl In .Controls
         If ctl.Name Like "CheckBox*" Then
            If ctl.Value = True Then
                  s = s + 1
                  arr(s, 1) = ctl.Caption
            End If
         End If
      Next
End With

With Sheets("sheet1").Range("j5")
      .Resize(UBound(arr)).ClearContents
      .Resize(s) = arr
End With

End Sub

Book1b.rar (13.27 KB, 下载次数: 6)

c888 · 发表于 2012-11-13 15:05

爱疯发表于 2012-11-13 14:48
Private Sub CommandButton1_Click()
Dim ctl As Control
Dim arr()

爱疯老师！谢谢您是这样子。
还有一个问题想请教下：当在复选框输入选定的号码后（确定），关闭窗体下次再打开时，能否将前次已输入的号码，在窗体的复选框上显示出来（打勾）。谢谢指导！

爱疯 · 发表于 2012-11-13 15:34

Private Sub UserForm_Initialize()
Dim arr, i%

'导入到窗体
With Sheets("sheet1")
      If Application.Sum(.Range("J5:j9")) = 0 Then End
      arr = .Range("J5:j9") '范围可能会改
End With
For i = 1 To UBound(arr)
      If arr(i, 1) Like "#" And arr(i, 1) > 0 Then
         Me.Controls("checkbox" & arr(i, 1)) = True
      End If
Next i

End Sub

Book1c.rar (13.96 KB, 下载次数: 3)

		自动登录	找回密码
密码			注册