⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄

📁 这是一个用vb+SQL Server数据库编写的样品检验代码。包括样品的购买库存以及检验的各项程序
💻
📖 第 1 页 / 共 4 页
字号:
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 + -