📄
字号:
Do While lentext <> 0
N_JYXM(i, 0) = Left(temptext, 4) '项目代码
lentext = lentext - 4
Adodc2.RecordSource = "select * from 项目表 where 项目代码 like '" & N_JYXM(i, 0) & "'"
Adodc2.Refresh
N_JYXM(i, 1) = Trim(TxtXMMC.Text) '项目名称
N_JYXM(i, 2) = Trim(TxtZB.Text) '项目 指标
temptext = Right(temptext, lentext)
N_JYXM(i, 3) = Left(temptext, 1) '周期
lentext = lentext - 1
temptext = Right(temptext, lentext)
Adodc3.RecordSource = "select * from 周期表 where 周期='" & N_JYXM(i, 3) & "'"
Adodc3.Refresh
N_JYXM(i, 4) = TxtCXZ.Text '抽象值
'下面对检验历史字符串进行分析 例如: N1N3Y2003M12
P_JYLS = Trim(TxtJYLS.Text)
tempjyls = Right(P_JYLS, Len(P_JYLS) - O_len)
lenjyls = Len(tempjyls)
Select Case Left(tempjyls, 1)
Case "N"
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
N_JYXM(i, 5) = Left(tempjyls, 1) '检验周期
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
O_len = O_len + 2 'O_len表示这次循环去除掉的字符个数
Case "Y"
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
N_JYXM(i, 5) = Left(tempjyls, 4) '检验周期
lenjyls = lenjyls - 4
tempjyls = Right(tempjyls, lenjyls)
O_len = O_len + 5
Case "M"
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
N_JYXM(i, 5) = Left(tempjyls, 2) '检验周期
lenjyls = lenjyls - 2
tempjyls = Right(tempjyls, lenjyls)
O_len = O_len + 3
End Select
i = i + 1
y = y + 1
Loop
'下面用来显示项目说明的6个list
ListXMDH.Clear
ListXMMC.Clear
ListZB.Clear
ListJYZQ.Clear
ListCXZ.Clear
ListJYLS.Clear
For i = 0 To y - 1
ListXMDH.AddItem ("-" & N_JYXM(i, 0))
ListXMMC.AddItem ("-" & N_JYXM(i, 1))
ListZB.AddItem ("-" & N_JYXM(i, 2))
Select Case N_JYXM(i, 3)
Case "A"
ListJYZQ.AddItem ("-" & N_JYXM(i, 3) & "-每批")
Case "B"
ListJYZQ.AddItem ("-" & N_JYXM(i, 3) & "-每年")
Case "D"
ListJYZQ.AddItem ("-" & N_JYXM(i, 3) & "-每5批")
Case "E"
ListJYZQ.AddItem ("-" & N_JYXM(i, 3) & "-每10批")
End Select
ListCXZ.AddItem ("-" & N_JYXM(i, 4))
ListJYLS.AddItem ("-" & N_JYXM(i, 5))
Next i
Adodc2.RecordSource = "select * from 项目表"
Adodc2.Refresh
Adodc3.RecordSource = "select * from 周期表"
Adodc3.Refresh
End Sub
Private Sub CmdRefresh_Click()
Adodc1.RecordSource = " select * from 样品信息表"
Adodc1.Refresh
End Sub
Private Sub Command1_Click()
Adodc1.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=样品检测项目系统"
Adodc2.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=样品检测项目系统"
Adodc3.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=样品检测项目系统"
End Sub
Private Sub DataGrid1_DblClick()
P_YPMC = Trim(TxtYPMC.Text)
P_JYXM = Trim(TxtJYXM.Text)
'下面对检验项目代码进行分析,形成N_JYXM数组
'Adodc1.Recordset.Fields(j).Value
lenth_JYXM = Len(P_JYXM)
temptext = P_JYXM
lentext = lenth_JYXM
'Option Base 1
'Rows = lentext / 5
Dim N_JYXM(29, 5)
i = 0
y = 0 '用Y来记录N_JYXM数组的行数。
Do While lentext <> 0
N_JYXM(i, 0) = Left(temptext, 4) '项目代码
lentext = lentext - 4
Adodc2.RecordSource = "select * from 项目表 where 项目代码 like '" & N_JYXM(i, 0) & "'"
Adodc2.Refresh
N_JYXM(i, 1) = Trim(TxtXMMC.Text) '项目名称
N_JYXM(i, 2) = Trim(TxtZB.Text) '项目 指标
temptext = Right(temptext, lentext)
N_JYXM(i, 3) = Left(temptext, 1) '周期
lentext = lentext - 1
temptext = Right(temptext, lentext)
Adodc3.RecordSource = "select * from 周期表 where 周期='" & N_JYXM(i, 3) & "'"
Adodc3.Refresh
N_JYXM(i, 4) = TxtCXZ.Text '抽象值
'下面对检验历史字符串进行分析 例如: N1N3Y2003M12
P_JYLS = Trim(TxtJYLS.Text)
tempjyls = Right(P_JYLS, Len(P_JYLS) - O_len)
lenjyls = Len(tempjyls)
Select Case Left(tempjyls, 1)
Case "N"
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
N_JYXM(i, 5) = Left(tempjyls, 1) '检验周期
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
O_len = O_len + 2 'O_len表示这次循环去除掉的字符个数
Case "Y"
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
N_JYXM(i, 5) = Left(tempjyls, 4) '检验周期
lenjyls = lenjyls - 4
tempjyls = Right(tempjyls, lenjyls)
O_len = O_len + 5
Case "M"
lenjyls = lenjyls - 1
tempjyls = Right(tempjyls, lenjyls)
N_JYXM(i, 5) = Left(tempjyls, 2) '检验周期
lenjyls = lenjyls - 2
tempjyls = Right(tempjyls, lenjyls)
O_len = O_len + 3
End Select
i = i + 1
y = y + 1
Loop
'下面是测试程序。
'Form1.Show
'For i = 0 To Rows
' For j = 0 To 5
' Form1.Print N_JYXM(i, j);
' Form1.Print " "
' Next j
' Form1.Print
'Next i
'下面对检验周期的抽象值和检验历史进行对比,形成NEW_JYXM数组.得出这次的检验任务
Dim NEW_JYXM(29, 5)
'Dim NEW_Y As Integer
Dim NEW_I As Integer '用NEW_I表示NEW_JYXM有效行数。因为NEW_JYXM与N_JYXM维数不一样。
For i = 0 To y
Select Case N_JYXM(i, 4) '已用字符 1. 7. 5. 8. 9.
Case 1 '每批都要检验的项目
NEW_JYXM(NEW_I, 0) = N_JYXM(i, 0)
NEW_JYXM(NEW_I, 1) = N_JYXM(i, 1)
NEW_JYXM(NEW_I, 2) = N_JYXM(i, 2)
NEW_JYXM(NEW_I, 3) = N_JYXM(i, 3)
NEW_JYXM(NEW_I, 4) = N_JYXM(i, 4)
NEW_JYXM(NEW_I, 5) = N_JYXM(i, 5)
NEW_I = NEW_I + 1
'NEW_Y = NEW_Y + 1 '计数
Case 7 '每年一次要检测的项目
If N_JYXM(i, 5) <> Val(Left(Date, 4)) Then
NEW_JYXM(NEW_I, 0) = N_JYXM(i, 0)
NEW_JYXM(NEW_I, 1) = N_JYXM(i, 1)
NEW_JYXM(NEW_I, 2) = N_JYXM(i, 2)
NEW_JYXM(NEW_I, 3) = N_JYXM(i, 3)
NEW_JYXM(NEW_I, 4) = N_JYXM(i, 4)
NEW_JYXM(NEW_I, 5) = N_JYXM(i, 5)
NEW_I = NEW_I + 1
N_JYXM(i, 5) = Val(Left(Date, 4)) '形成历史
'NEW_Y = NEW_Y + 1 '计数
End If
Case 5 '每5批要检验一次的项目
If N_JYXM(i, 5) = 1 Then
NEW_JYXM(NEW_I, 0) = N_JYXM(i, 0)
NEW_JYXM(NEW_I, 1) = N_JYXM(i, 1)
NEW_JYXM(NEW_I, 2) = N_JYXM(i, 2)
NEW_JYXM(NEW_I, 3) = N_JYXM(i, 3)
NEW_JYXM(NEW_I, 4) = N_JYXM(i, 4)
NEW_JYXM(NEW_I, 5) = N_JYXM(i, 5)
NEW_I = NEW_I + 1
N_JYXM(i, 5) = N_JYXM(i, 5) + 1 '形成历史
If N_JYXM(i, 5) = 6 Then N_JYXM(i, 5) = 1
'NEW_Y = NEW_Y + 1 '计数
Else
N_JYXM(i, 5) = N_JYXM(i, 5) + 1 '形成历史
If N_JYXM(i, 5) = 6 Then N_JYXM(i, 5) = 1
End If
Case 9 '每10批要检验一次的项目
If N_JYXM(i, 5) = 1 Then
NEW_JYXM(NEW_I, 0) = N_JYXM(i, 0)
NEW_JYXM(NEW_I, 1) = N_JYXM(i, 1)
NEW_JYXM(NEW_I, 2) = N_JYXM(i, 2)
NEW_JYXM(NEW_I, 3) = N_JYXM(i, 3)
NEW_JYXM(NEW_I, 4) = N_JYXM(i, 4)
NEW_JYXM(NEW_I, 5) = N_JYXM(i, 5)
NEW_I = NEW_I + 1
If N_JYXM(i, 5) = "A" Then '以下IF语句用于将超过9次的数字转化为16进A、B
N_JYXM(i, 5) = "B" '目的是报纸所有的抽象值只有一位
Else 'A代表10 B代表11
N_JYXM(i, 5) = N_JYXM(i, 5) + 1 '
End If '
If N_JYXM(i, 5) = 10 Then N_JYXM(i, 5) = "A" '
If N_JYXM(i, 5) = "B" Then N_JYXM(i, 5) = 1 '
Else
If N_JYXM(i, 5) = "A" Then
N_JYXM(i, 5) = "B"
Else
N_JYXM(i, 5) = N_JYXM(i, 5) + 1 '形成历史
End If
If N_JYXM(i, 5) = 10 Then N_JYXM(i, 5) = "A"
If N_JYXM(i, 5) = "B" Then N_JYXM(i, 5) = 1
End If
Case 6 '每月要检验一次的项目
If N_JYXM(i, 5) <> Month(d) Then
NEW_JYXM(NEW_I, 0) = N_JYXM(i, 0)
NEW_JYXM(NEW_I, 1) = N_JYXM(i, 1)
NEW_JYXM(NEW_I, 2) = N_JYXM(i, 2)
NEW_JYXM(NEW_I, 3) = N_JYXM(i, 3)
NEW_JYXM(NEW_I, 4) = N_JYXM(i, 4)
NEW_JYXM(NEW_I, 5) = N_JYXM(i, 5)
NEW_I = NEW_I + 1
N_JYXM(i, 5) = Val(Month(d)) '形成历史
'NEW_Y = NEW_Y + 1 '计数
End If
End Select
Next i
' 下面测试NEW_JYXM数组
'Form1.Show
'For i = 0 To NEW_Y
' For j = 1 To 5
' Form1.Print NEW_JYXM(i, j);
' Next j
' Print
'Next i
'Form1.Print NEW_Y
msgtext = "此次共有 " & NEW_I & " 个项目要检验"
MsgBox (msgtext)
'下面将这次检验形成历史记录。即把N_JYXM数组形成新的检验历史字符串,并存入 样品信息表 中
Dim NEW_JYLS As String
For i = 0 To y
Select Case N_JYXM(i, 4) '根据抽象值
Case 1
NEW_JYLS = NEW_JYLS + N_JYLS & "N1"
Case 5
NEW_JYLS = NEW_JYLS + N_JYLS & "N" & N_JYXM(i, 5)
Case 6
NEW_JYLS = NEW_JYLS + N_JYLS & "M" & N_JYXM(i, 5)
Case 7
NEW_JYLS = NEW_JYLS + N_JYLS & "Y" & N_JYXM(i, 5)
Case 9
NEW_JYLS = NEW_JYLS + N_JYLS & "N" & N_JYXM(i, 5)
End Select
Next i
Adodc1.Recordset!检验历史 = NEW_JYLS
Adodc1.Recordset.Update
Adodc1.Refresh
'下面将NEW_JYXM数组到处到EXCEL中形成报表
Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
xlApp.Visible = True '设置EXCEL可见
Path = App.Path & "\报表.xls"
Set xlBook = xlApp.Workbooks.Open(Path) '打开EXCEL工作簿
Set xlSheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlSheet.Activate '激活工作表
' xlSheet.Cells(1, 1) = "abc" '给单元格1行驶列赋值
For i = 0 To NEW_I
For j = 0 To 5
xlSheet.Cells(i + 1, j + 1) = NEW_JYXM(i, j)
Next j
Next i
End Sub
Private Sub Form_Load()
SSTab1.Tab = 0
End Sub
Private Sub ListJYLS_Click()
Row = ListJYLS.ListIndex
ListXMDH.ListIndex = Row
ListXMMC.ListIndex = Row
ListZB.ListIndex = Row
ListJYZQ.ListIndex = Row
ListJYLS.ListIndex = Row
End Sub
Private Sub ListJYZQ_Click()
Row = ListJYZQ.ListIndex
ListXMDH.ListIndex = Row
ListXMMC.ListIndex = Row
ListZB.ListIndex = Row
ListJYZQ.ListIndex = Row
ListJYLS.ListIndex = Row
End Sub
Private Sub ListXMDH_Click()
Row = ListXMDH.ListIndex
ListXMDH.ListIndex = Row
ListXMMC.ListIndex = Row
ListZB.ListIndex = Row
ListJYZQ.ListIndex = Row
ListJYLS.ListIndex = Row
End Sub
Private Sub ListXMMC_Click()
Row = ListXMMC.ListIndex
ListXMDH.ListIndex = Row
ListXMMC.ListIndex = Row
ListZB.ListIndex = Row
ListJYZQ.ListIndex = Row
ListJYLS.ListIndex = Row
End Sub
Private Sub ListZB_Click()
Row = ListZB.ListIndex
ListXMDH.ListIndex = Row
ListXMMC.ListIndex = Row
ListZB.ListIndex = Row
ListJYZQ.ListIndex = Row
ListJYLS.ListIndex = Row
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case JYXMSC
检验项目生成.Show
Case 2
项目表.Show
Case 3
样品信息表.Show
Case 4
周期表.Show
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -