frmbarcode.frm

对于一个产品

Private Sub chkShowAll_Click()
    If chkShowAll.Value = 1 Then
        FTog = "ShowAll"
        FillLstBarCode
        FTog = ""
    Else
        LblRec1.Caption = "0"
        LstBarCode.Clear
    End If
End Sub

Private Sub cmdAdd_Click()
    FTog = "Add"
    DTPicker1.Enabled = True
    DTPicker1.Value = Date
    txtPartNo.Enabled = True
    txtModel.Enabled = True
    MaskQtyIn.Enabled = True
    
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    cmdDele.Enabled = False
    cmdOK.Enabled = True
    cmdCancel.Enabled = True

    chkShowAll.Enabled = False
    cmdStart.Enabled = False
    LstLabel.Enabled = False
    LstBarCode.Enabled = False
    
    ClearF
End Sub

Private Sub cmdCancel_Click()
    Init
End Sub

Private Sub cmdContinue_Click()
    cmdDone.Enabled = True

    txtBarcode.Enabled = True
    txtBarcode.Text = ""
    txtBarcode.BackColor = vbWhite
    txtBarcode.ForeColor = vbBlack
    txtBarcode.SetFocus
    cmdRecheck.Visible = False
    cmdContinue.Visible = False
End Sub

Private Sub cmdDele_Click()
    If LstLabel.SelCount = 0 And LstLabelF.SelCount = 0 Then
        MsgBox "请选择要删除的记录!", vbInformation, "系统提示"
        Exit Sub
    End If

    FTog = "Dele"

    DTPicker1.Enabled = False
    txtPartNo.Enabled = False
    txtModel.Enabled = False
    MaskQtyIn.Enabled = False
    ChkPass.Enabled = False
    MaskQtyNg.Enabled = False
    TxtRemark.Enabled = False
    
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    cmdDele.Enabled = False
    cmdOK.Enabled = True
    cmdCancel.Enabled = True
    
    chkShowAll.Enabled = False
    cmdStart.Enabled = False
    LstLabel.Enabled = False
    LstLabelF.Enabled = False
    cmdTransfer.Enabled = False
    LstBarCode.Enabled = False
End Sub

Private Sub cmdDone_Click()
    txtBarcode.Text = ""
    txtBarcode.Enabled = False
    
    ChkPass.Enabled = True
    MaskQtyNg.Enabled = True
    TxtRemark.Enabled = True
    
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    cmdDele.Enabled = False
    cmdOK.Enabled = True
    cmdCancel.Enabled = True
    
    FTog = "Edit"
    cmdDone.Enabled = False
    cmdDone.Visible = False
End Sub

Private Sub cmdEdit_Click()
    If LstLabel.SelCount = 0 Then
        MsgBox "请选择要修改的记录!", vbInformation, "系统提示"
        LstLabel.SetFocus
        Exit Sub
    End If

    FTog = "Edit"

    txtModel.Enabled = True
    MaskQtyIn.Enabled = True
    
    ChkPass.Enabled = True
    MaskQtyNg.Enabled = True
    TxtRemark.Enabled = True
    
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    cmdDele.Enabled = False
    cmdOK.Enabled = True
    cmdCancel.Enabled = True
    
    chkShowAll.Enabled = False
    cmdStart.Enabled = False
    LstLabel.Enabled = False
    LstBarCode.Enabled = False
End Sub

Private Sub subDele()
    If selSNo > "" Then
        If LblRec1.Caption > "0" Then
            tmprep = MsgBox("已有条码检查记录，删除批次将删除检查记录!", vbYesNo + vbQuestion, "系统提示")
            If tmprep = 6 Then
                strSQL = "delete from QABarCode where SNo = '" & selSNo & "'"
                cn.Execute strSQL
            Else
                cmdAdd.Enabled = True
                cmdEdit.Enabled = True
                cmdDele.Enabled = True
    
                cmdOK.Enabled = False
                cmdCancel.Enabled = False
                Exit Sub
            End If
        End If
    
        strFilter = " where SNo = '" & selSNo & "'"
        strSQL = "delete from QALabel" & strFilter
    
        cmdAdd.Enabled = True
        cmdEdit.Enabled = True
    End If
    
    If selSNoF > "" Then
        If LblRec1.Caption > "0" Then
            tmprep = MsgBox("已有条码检查记录，删除批次将删除检查记录!", vbYesNo + vbQuestion, "系统提示")
            If tmprep = 6 Then
                strSQL = "delete from QABarCodeF where SNo = '" & selSNoF & "'"
                cn.Execute strSQL
            Else
                cmdDele.Enabled = True
    
                cmdOK.Enabled = False
                cmdCancel.Enabled = False
                Exit Sub
            End If
        End If
    
        strFilter = " where SNo = '" & selSNoF & "'"
        strSQL = "delete from QALabelF" & strFilter
    End If
    
    cn.Execute strSQL
        
    MsgBox "[批次] 删除完成!", vbInformation, "系统提示"
        
    cmdAdd.Enabled = True
    cmdEdit.Enabled = True
    cmdDele.Enabled = True
    cmdOK.Enabled = False
    cmdCancel.Enabled = False
    
    LblSNo.Caption = ""
    txtPartNo.Text = ""
    txtModel.Text = ""
    MaskQtyIn.Text = ""
    
    ChkPass.Value = 0
    MaskQtyNg.Text = ""
    TxtRemark.Text = ""
    LblRec1.Caption = "0"
    LstBarCode.Clear
End Sub

Private Sub subEdit()
    datDateIn = DTPicker1.Value
    strPartNo = Trim(txtPartNo.Text)
    strFilter = " where SNo = '" & selSNo & "'"

    strModel = Trim(txtModel.Text)
    If strModel = "" Then
        MsgBox "请录入 [机型]!", vbInformation, "系统提示"
        txtModel.SetFocus
        Exit Sub
    End If
    
    sngQtyIn = 0
    If Not IsNumeric(Trim(MaskQtyIn.Text)) Then
        MsgBox "请录入 [来货数量]!", vbInformation, "系统提示"
        MaskQtyIn.SetFocus
        Exit Sub
    Else
        sngQtyIn = CSng(MaskQtyIn.Text)
    End If
   
    sngQtyNg = 0
    If Trim(MaskQtyNg.Text) = "" Then
    Else
        If Not IsNumeric(Trim(MaskQtyNg.Text)) Then
            MsgBox "请录入 [NG数量]!", vbInformation, "系统提示"
            MaskQtyNg.SetFocus
            Exit Sub
        Else
            sngQtyNg = CSng(MaskQtyNg.Text)
            If sngQtyNg > sngQtyIn Then
                MsgBox "[NG数量] 过大!", vbExclamation, "系统提示"
                MaskQtyNg.SetFocus
                Exit Sub
            End If
        End If
    End If
   
    bitPass = ChkPass.Value
    strRemark = Trim(TxtRemark.Text)
   
    strSQL = "update QALabel set Model = '" & strModel & "', QtyIn = " & sngQtyIn & ", UserID = '" & pubUserID & "',"
    strSQL = strSQL & " Pass = " & bitPass & ", QtyNg = " & sngQtyNg & ", Remark = '" & strRemark & "'"
    strSQL = strSQL & strFilter
    
    cn.Execute strSQL
    MsgBox "[批次] 修改完成!", vbInformation, "系统提示"
        
    txtModel.Enabled = False
    MaskQtyIn.Enabled = False
    
    ChkPass.Enabled = False
    MaskQtyNg.Enabled = False
    TxtRemark.Enabled = False
    
    cmdAdd.Enabled = True
    cmdEdit.Enabled = True
    cmdDele.Enabled = True
    
    cmdOK.Enabled = False
    cmdCancel.Enabled = False
    
    cmdStart.Visible = True
    cmdStart.Enabled = True
End Sub

Private Sub cmdExcel_Click()
    Dim VBExcel As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet

    Set VBExcel = CreateObject("Excel.Application")
    VBExcel.Visible = True
    
    Set xlBook = VBExcel.Workbooks.Open(App.Path & "\QALabel.xls")
    Set xlSheet = xlBook.Worksheets("BarCode")
    xlSheet.Activate
    i = 3
    
    strSQL = "select * from QALabel order by SNo"
    Set rs1 = cn.Execute(strSQL)
    While Not rs1.EOF
        strSNo = rs1("SNo")
        strDateIn = rs1("DateIn")
        strPartNo = rs1("PartNo")
        strModel = Trim(rs1("Model"))
        strQtyIn = rs1("QtyIn")
        strQtyNg = rs1("QtyNg")
        strUserID = Trim(rs1("UserID"))
        
        strPass = rs1("Pass")
        If strPass = "True" Then
            strPass = "√"
        Else
            strPass = ""
        End If
        
        strRemark = Trim(rs1("Remark"))
    
        strSQL = "select * from QABarCode where SNo = '" & strSNo & "' order by BarCode"
        Set rs = cn.Execute(strSQL)
        strBarCode = ""
        strDateDet = ""
        tbc = 0
        While Not rs.EOF
            tbc = tbc + 1
            strBarCode = Trim(rs("BarCode"))
            strDateDet = rs("DateDet")
            With xlSheet
                i = i + 1
                CellA = "A" & i
                CellB = "B" & i
                CellC = "C" & i
                CellD = "D" & i
                CellE = "E" & i
                CellF = "F" & i
                CellG = "G" & i
                CellH = "H" & i
                CellI = "I" & i
                CellJ = "J" & i
                CellK = "K" & i
                '不输出重复显示
                If tbc = 1 Then
                    .Range(CellA).Value = strSNo
                    .Range(CellB).Value = strDateIn
                    .Range(CellC).Value = strPartNo
                    .Range(CellD).Value = strModel
                    .Range(CellE).Value = strQtyIn
                    .Range(CellF).Value = strQtyNg
                    .Range(CellG).Value = strUserID
                    .Range(CellH).Value = strPass
                    .Range(CellI).Value = strRemark
                End If
                
                .Range(CellJ).Value = strBarCode
                .Range(CellK).Value = strDateDet
            End With
            rs.MoveNext
        Wend
        rs.Close
        rs1.MoveNext
    Wend
    rs1.Close
    
    With xlSheet
        .Columns("A:K").AutoFit
        .Range("D4").Select
    End With

    'xlBook.Close
    'VBExcel.Quit
    'Set VBExcel = Nothing
End Sub

Private Sub cmdOK_Click()
    Select Case FTog
        Case "Add"
            subAdd
        Case "Edit"
            subEdit
        Case "Dele"
            subDele
            FillLstLabelF
    End Select
    
    FillLstLabel
    chkShowAll.Enabled = True
    cmdStart.Enabled = True
    LstLabel.Enabled = True
    LstLabelF.Enabled = True
    cmdTransfer.Enabled = True
    LstBarCode.Enabled = True
    cmdExcel.Enabled = True
    cmdQuit.Enabled = True
End Sub

Private Sub subAdd()
    datDateIn = DTPicker1.Value
    
    strPartNo = Trim(txtPartNo.Text)
    If strPartNo = "" Then
        MsgBox "请录入 [物料编码]!", vbInformation, "系统提示"
        txtPartNo.SetFocus
        Exit Sub
    End If
        
    '查找是否有相同[批次]
    strFilter = " where DateIn = '" & datDateIn & "' and PartNo = '" & strPartNo & "'"
    strSQL = "select count(*) from QALabel" & strFilter
    Set rs1 = cn.Execute(strSQL)
    If rs1(0) > 0 Then
        MsgBox "已存在此 [批次]!", vbInformation, "系统提示"
        rs1.Close
        txtPartNo.SetFocus
        Exit Sub
    End If
    rs1.Close

    strModel = Trim(txtModel.Text)
    If strModel = "" Then
        MsgBox "请录入 [机型]!", vbInformation, "系统提示"
        txtModel.SetFocus
        Exit Sub
    End If
    
    sngQtyIn = 0
    If Not IsNumeric(Trim(MaskQtyIn.Text)) Then
        MsgBox "请录入 [来货数量]!", vbInformation, "系统提示"
        MaskQtyIn.SetFocus
        Exit Sub
    Else
        sngQtyIn = CSng(MaskQtyIn.Text)
    End If
   
    '查找最大的SNo
    newSNo = "0"
    newSNoF = "0"
    
    If LblRecord.Caption = "0" And LblRecordF.Caption = "0" Then
        newSNo = "0"
    Else
        strSQL = "select Max(SNo) from QALabel"
        Set rs1 = cn.Execute(strSQL)
        newSNo = rs1(0)
        rs1.Close
    
        strSQL = "select Max(SNo) from QALabelF"
        Set rs1 = cn.Execute(strSQL)
        newSNoF = rs1(0)
        rs1.Close
    
        If newSNoF > newSNo Then newSNo = newSNoF
    End If
    
    newSNo = newSNo + 1
    tmpLen = 8 - Len(newSNo)
    newSNo = String$(tmpLen, "0") & newSNo
    
    strSQL = "insert into QALabel(SNo, DateIn, PartNo, Model, QtyIn, UserID)"
    strSQL = strSQL & " values('" & newSNo & "', '" & datDateIn & "', '" & strPartNo & "', '" & strModel & "', " & sngQtyIn & ", '" & pubUserID & "')"
        
    cn.Execute strSQL
        
    MsgBox "[批次] 添加完成!", vbInformation, "系统提示"
        
    DTPicker1.Enabled = False
    txtPartNo.Enabled = False
    txtModel.Enabled = False
    MaskQtyIn.Enabled = False
    
    cmdAdd.Enabled = True
    cmdEdit.Enabled = True
    cmdDele.Enabled = True