[已解决]求助为什么生成试室时超过30个试室即出错

qinhuan66

求助为什么生成试室时超过30个试室即出错?(30以内正常)
求助.rar (42.08 KB, 下载次数: 11)

2013-6-18 08:49 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-18 09:00

1. Function CheckInput()
   
2.     Dim objControl As Control
   
3.     Dim str$
   
4.     Dim strTemp
   
5.     Dim arr(), i As Byte
   
6.     ReDim arr(1 To 60, 1 To 2)
   
7.     For Each objControl In Me.Controls
   
8. 
   
9.         If TypeName(objControl) Like "CheckBox" Then
   
10.             With objControl
    
11.                 If .Value Then
    
12.                 strTemp = Me.Controls(Replace(.Name, "CheckBox", "TextBox")).Text
    
13.                     If Not IsNumeric(strTemp) Or strTemp Like "*[.-]*" Then
    
14.                         str = str & .Name & " 后面的文本框输入的是非大于0的整数值" & vbCrLf
    
15.                     Else
    
16.                        i = i + 1
    
17.                        arr(i, 1) = Mid(.Name, 9)
    
18.                        arr(i, 2) = Val(strTemp)
    
19.                     End If
    
20.                 End If
    
21.             End With
    
22.         End If
    
23.     Next
    
24.     CheckInput = Not Len(str) > 0
    
25.     If Not CheckInput Then
    
26.         MsgBox str
    
27.     Else
    
28.         CheckInput = arr
    
29.     End If
    
30. End Function

复制代码

跳转到最佳答案楼层

hwc2ycy

    ReDim arr(1 To 30, 1 To 2)
这里定死了。

hwc2ycy

你改成这样试试吧。
ReDim arr(1 To 60, 1 To 2)
刚好60个控件。

hwc2ycy

1. Function CheckInput()
   
2.     Dim objControl As Control
   
3.     Dim str$
   
4.     Dim strTemp
   
5.     Dim arr(), i As Byte
   
6.     ReDim arr(1 To 60, 1 To 2)
   
7.     For Each objControl In Me.Controls
   
8. 
   
9.         If TypeName(objControl) Like "CheckBox" Then
   
10.             With objControl
    
11.                 If .Value Then
    
12.                 strTemp = Me.Controls(Replace(.Name, "CheckBox", "TextBox")).Text
    
13.                     If Not IsNumeric(strTemp) Or strTemp Like "*[.-]*" Then
    
14.                         str = str & .Name & " 后面的文本框输入的是非大于0的整数值" & vbCrLf
    
15.                     Else
    
16.                        i = i + 1
    
17.                        arr(i, 1) = Mid(.Name, 9)
    
18.                        arr(i, 2) = Val(strTemp)
    
19.                     End If
    
20.                 End If
    
21.             End With
    
22.         End If
    
23.     Next
    
24.     CheckInput = Not Len(str) > 0
    
25.     If Not CheckInput Then
    
26.         MsgBox str
    
27.     Else
    
28.         CheckInput = arr
    
29.     End If
    
30. End Function

复制代码

hwc2ycy

当时做的时候，估计只有30个控件，所以给定了30.

妞叫七七

楼主,看你选这么多控件给累的,,为什么不设置一个本列全选的选项呢,就象邮箱中的那样

qinhuan66

hwc2ycy 发表于 2013-6-18 08:58
ReDim arr(1 To 30, 1 To 2)
这里定死了。

刚才我以为是2排,我改成1TO4,唉怎么忘记了是共30个试室呢.
ReDim arr(1 To 30, 1 To 4)

谢谢您了老师

hwc2ycy

妞叫七七 发表于 2013-6-18 09:09
楼主,看你选这么多控件给累的,,为什么不设置一个本列全选的选项呢,就象邮箱中的那样

应该还要来个自动填充那就更完美了。

qinhuan66

hwc2ycy 发表于 2013-6-18 09:14
应该还要来个自动填充那就更完美了。

我已做全选了和不全选 了,老师自动填充怎么做呢?我也想到这个但不会弄只好作罢了.(就是输入人数就动打钩,是不是这样?)谢谢
Private Sub CommandButton2_Click()
    Dim objControl As Control
    For Each objControl In Me.Controls
        If TypeName(objControl) Like "CheckBox" Then
            objControl.Value = True
        End If
    Next
End Sub
Private Sub CommandButton4_Click()
Dim objControl As Control
    For Each objControl In Me.Controls
        If TypeName(objControl) Like "CheckBox" Then
            objControl.Value = False
        End If
    Next
End Sub

hwc2ycy

qinhuan66 发表于 2013-6-18 09:24
我已做全选了和不全选 了,老师自动填充怎么做呢?我也想到这个但不会弄只好作罢了.(就是输入人数就动打钩, ...

1. '针对勾选的自动填充，你也可以改成对所有的填充。
   
2.     Dim lNumber As Long
   
3.     Dim objControl As Object
   
4.     Dim blIsAutofill As Boolean
   
5.     lNumber = Application.InputBox(prompt:="请输入要填入的数值[>0]：", Title:="自动填充", Default:=1, Type:=1)
   
6.     If lNumber <= 0 Then MsgBox "数值不合要求": Exit Sub
   
7. 
   
8.     For Each objControl In Me.Controls
   
9.         If TypeName(objControl) Like "CheckBox" Then
   
10.             With objControl
    
11.                 If .Value Then
    
12.                     blIsAutofill = True
    
13.                     Me.Controls(Replace(.Name, "CheckBox", "TextBox")).Text = lNumber
    
14.                 End If
    
15.             End With
    
16. 
    
17.         End If
    
18.     Next
    
19.     If blIsAutofill Then
    
20.         MsgBox "填充完毕"
    
21.     Else
    
22.         MsgBox "没有选择的单元框"
    
23.     End If
    

复制代码