📄 form1.frm
字号:
CheckBock = CheckBock + 1
OpenBoleID(Index) = True
Else
CheckBock = CheckBock - 1
OpenBoleID(Index) = False
End If
End Sub
Private Sub Command1_Click()
If CheckVock < 8 Then Exit Sub
If CheckBock < 4 Then Exit Sub
Combo3.Clear
Combo4.Clear
List1.Clear
List2.Clear
List4.Clear
List3.Clear
List5.Clear
List6.Clear
Command5 = True
Command6 = True
Form3.Show
For I = 0 To Combo3.ListCount - 1
Dim tmp
Dim tmpp
tmp = Split(Combo3.List(I), "+")
tmpp = Split(Combo4.List(I), "+")
Dim str() As String
str = Split(Combo3.List(I), "=")
Dim str1() As String
str1 = Split(Combo4.List(I), "=")
Dim ShowOCNum1 As Integer
Dim ShowOCNum3 As Integer
Dim ShowOCNum2 As Integer
Dim ShowOCNum4 As Integer
ShowOCNum1 = 0
ShowOCNum2 = 0
ShowOCNum3 = 0
ShowOCNum4 = 0
For Ix = 0 To 4
If OCNum(tmp(Ix)) = True Then
ShowOCNum1 = ShowOCNum1 + 1
Else
ShowOCNum3 = ShowOCNum3 + 1
End If
Next Ix
For Ic = 0 To 1
If OCNum(tmpp(Ic)) = True Then
ShowOCNum2 = ShowOCNum2 + 1
Else
ShowOCNum4 = ShowOCNum4 + 1
End If
Next Ic
Set itmX = Form3.ListView1.ListItems.Add(, , tmp(0) & "+" & tmp(1) & "+" & tmp(2) & "+" & tmp(3) & "+" & tmp(4) & " [ " & tmpp(0) & "+" & tmpp(1) & " ]")
itmX.SubItems(1) = str(UBound(str))
itmX.SubItems(2) = str1(UBound(str1))
itmX.SubItems(3) = ShowOCNum1 & ":" & ShowOCNum3
itmX.SubItems(4) = ShowOCNum2 & ":" & ShowOCNum4
Next I
Unload Me
End Sub
Private Sub Command2_Click()
For I = 0 To 34
Check1(I).Value = 1
Next I
End Sub
Private Sub Command3_Click()
For I = 0 To 34
If Check1(I).Value = 0 Then
Check1(I).Value = 1
Else
Check1(I).Value = 0
End If
Next I
End Sub
Private Sub Command4_Click()
For I = 0 To 11
If Check2(I).Value = 0 Then
Check2(I).Value = 1
Else
Check2(I).Value = 0
End If
Next I
End Sub
Private Sub Command5_Click()
If CheckVock < 8 Then
MsgBox "前区必须选中超过 “7” 个以上的号码!", vbExclamation, "错误的条件"
Exit Sub
End If
'Form3.Show
'Form2.Show , Form3
'Form2.Vop1.Max = Text3.Text'
'For i = 0 To Text3.Text
'Form2.Vop1.Value = i
'DoEvents
'Next i
For LisDoCmd = 1 To Text3.Text
Form2.Show , Me
Form2.Refresh
Form2.Label1.Caption = "正在添加前区号码,请稍后!"
Form2.Vop1.Max = Text3.Text
RegotoOut:
List1.Clear
List2.Clear
List3.Clear
List4.Clear
For I = 0 To 34
If OpenVoleID(I) = True Then
List1.AddItem Check1(I).Caption
End If
Next I
For I = 0 To List1.ListCount - 1
List3.AddItem List1.List(I)
Next I
Dim AcListInx As Long
AcListInx = 0
ReDim mArray(0 To 4)
For I = 0 To 4
AcListInx = AscRan(List3.ListCount)
List4.AddItem List3.List(AcListInx)
mArray(I) = List3.List(AcListInx)
List3.RemoveItem AcListInx
Next I
Dim AddCoutIndx As Integer
AddCoutIndx = 0
For I = 0 To 4
AddCoutIndx = AddCoutIndx + List4.List(I)
Next I
List4.Clear
Call QuickSort(mArray(), 0, UBound(mArray))
For I = 0 To UBound(mArray)
List4.AddItem mArray(I)
Next
Dim IDOKOut As String
IDOKOut = ""
If AddCoutIndx < Text1.Text Or AddCoutIndx > Text4.Text Then
GoTo RegotoOut
Else
For I = 0 To List4.ListCount - 1
IDOKOut = IDOKOut & List4.List(I) & "+"
Next I
'-----------------------------------------------------------------
If Not Combo1.ListIndex = "-1" Then
Dim tmp
Dim tmpp
tmp = Split(IDOKOut, "+")
Dim ShowOCNum1 As Integer
Dim ShowOCNum3 As Integer
ShowOCNum1 = 0
ShowOCNum3 = 0
For Ix = 0 To 4
If OCNum(tmp(Ix)) = True Then
ShowOCNum1 = ShowOCNum1 + 1
Else
ShowOCNum3 = ShowOCNum3 + 1
End If
Next Ix
If Not Combo1.Text = ShowOCNum1 & ":" & ShowOCNum3 Then GoTo RegotoOut
End If
Combo3.AddItem IDOKOut & "=" & AddCoutIndx
End If
DoEvents
Form2.Vop1.Value = LisDoCmd
Next LisDoCmd
Unload Form2
End Sub
Private Sub Command6_Click()
If CheckBock < 4 Then
MsgBox "后区必须选中超过 “3” 个以上的号码!", vbExclamation, "错误的条件"
Exit Sub
End If
For LisDoCmd = 1 To Text3.Text
Form2.Show , Me
Form2.Refresh
Form2.Label1.Caption = "正在添加后区号码,请稍后!"
Form2.Vop1.Max = Text3.Text
RegotoOut:
List2.Clear
List5.Clear
List6.Clear
For I = 0 To 11
If OpenBoleID(I) = True Then
List2.AddItem Check2(I).Caption
End If
Next I
For I = 0 To List2.ListCount - 1
List5.AddItem List2.List(I)
Next I
Dim AcListInx As Long
AcListInx = 0
ReDim mArray(0 To 1)
For I = 0 To 1
AcListInx = AscRan(List5.ListCount)
List6.AddItem List5.List(AcListInx)
mArray(I) = List5.List(AcListInx)
List5.RemoveItem AcListInx
Next I
Dim AddCoutIndx As Integer
AddCoutIndx = 0
For I = 0 To 1
AddCoutIndx = AddCoutIndx + List6.List(I)
Next I
List6.Clear
Call QuickSort(mArray(), 0, UBound(mArray))
For I = 0 To UBound(mArray)
List6.AddItem mArray(I)
Next
Dim IDOKOut As String
IDOKOut = ""
If AddCoutIndx < Text2.Text Or AddCoutIndx > Text5.Text Then
GoTo RegotoOut
Else
For I = 0 To List6.ListCount - 1
IDOKOut = IDOKOut & List6.List(I) & "+"
Next I
'-----------------------------------------------------------------
If Not Combo2.ListIndex = "-1" Then
Dim tmp
Dim tmpp
tmp = Split(IDOKOut, "+")
Dim ShowOCNum1 As Integer
Dim ShowOCNum3 As Integer
ShowOCNum1 = 0
ShowOCNum3 = 0
For Ix = 0 To 1
If OCNum(tmp(Ix)) = True Then
ShowOCNum1 = ShowOCNum1 + 1
Else
ShowOCNum3 = ShowOCNum3 + 1
End If
Next Ix
If Not Combo2.Text = ShowOCNum1 & ":" & ShowOCNum3 Then GoTo RegotoOut
End If
Combo4.AddItem IDOKOut & "=" & AddCoutIndx
End If
DoEvents
Form2.Vop1.Value = LisDoCmd
Next LisDoCmd
Unload Form2
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -