frmysd.frm

这是一个用VB编写出来的烟草管理系统

        db2.Close
        yfdj = rs1.Fields("yfdj")
        yfsl = rs1.Fields("yfsl")
        yfzl = rs1.Fields("yfzl")
        sssl = rs1.Fields("sssl")
        sszl = rs1.Fields("sszl")
        jjdj = rs1.Fields("jjdj")
        jjsl = rs1.Fields("jjsl")
        jjzl = rs1.Fields("jjzl")
        ID.Enabled = True
        fhdwdm.Enabled = True
        hqID.Enabled = True
        yfdj.Enabled = True
        yfsl.Enabled = True
        yfzl.Enabled = True
        sssl.Enabled = True
        sszl.Enabled = True
        jjdj.Enabled = True
        jjsl.Enabled = True
        jjzl.Enabled = True
    Else
        MsgBox ("没有此流水号！"), vbOKOnly, ("警告")
    End If
    cxtj = ""
    cxtj.SetFocus
    cx.Enabled = False
    xgbc.Enabled = True
End Sub


Private Sub lr_Click()
    ID = ""
    Date = ""
    fhdwdm = ""
    fhdwmc = ""
    hqID = ""
    hqmc = ""
    yfsl = ""
    yfzl = ""
    yfdj = ""
    sssl = ""
    sszl = ""
    jjsl = ""
    jjzl = ""
    jjdj = ""
    ID.Enabled = True
    Date.Enabled = True
    fhdwdm.Enabled = True
    hqID.Enabled = True
    yfsl.Enabled = True
    yfzl.Enabled = True
    yfdj.Enabled = True
    sssl.Enabled = True
    sszl.Enabled = True
    jjsl.Enabled = True
    jjzl.Enabled = True
    jjdj.Enabled = True
    ID.SetFocus
End Sub

Private Sub ID_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Date.SetFocus
    End If
End Sub
Private Sub Date_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        fhdwdm.SetFocus
    End If
End Sub
Private Sub fhdwdm_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Set db1 = OpenDatabase(App.Path + "..\db\System.mdb")
        Set rs1 = db1.OpenRecordset("select yz.yzmc from yz where yzID =" + Chr$(34) + fhdwdm + Chr$(34) + ";")
        If rs1.EOF = False Then
            fhdwmc = rs1.Fields("yzmc")
            db1.Close
            hqID.SetFocus
        Else
            MsgBox ("库中没有此烟站信息！"), vbOKOnly, ("警告")
            db1.Close
            fhdwdm = ""
            fhdwdm.SetFocus
        End If
    End If
End Sub
Private Sub hqID_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Set db1 = OpenDatabase(App.Path + "..\db\System.mdb")
        Set rs1 = db1.OpenRecordset("select hq.hqmc from hq where hqID =" + Chr$(34) + hqID + Chr$(34) + ";")
        If rs1.EOF = False Then
            hqmc = rs1.Fields("hqmc")
            db1.Close
            yfdj.SetFocus
        Else
            MsgBox ("库中没有此货区信息！"), vbOKOnly, ("警告")
            db1.Close
            hqID = ""
            hqID.SetFocus
        End If
    End If
End Sub

Private Sub xgbc_Click()
    Set db1 = OpenDatabase(App.Path + "..\db\Data.mdb")
    Set rs1 = db1.OpenRecordset("select * from dbd where lsh =" + Chr$(34) + lsh.Text + Chr$(34) + ";")
    With rs1
        .Edit
            !ID = ID
            !Date = Date
            !lsh = lsh
            !fhdwID = fhdwdm
            !hqID = hqID
            !yfsl = yfsl
            !yfzl = yfzl
            !yfdj = yfdj
            !sssl = sssl
            !sszl = sszl
            !ssdj = yfdj
            !jjsl = jjsl
            !jjzl = jjzl
            !jjdj = jjdj
        .Update
    End With
    If jjdj <> UCase("Null") Then
        Set rs2 = db.OpenRecordset("select * from jjd where ddh =" + Chr$(34) + ID.Text + Chr$(34) + ";")
        temlsh = rs2.Fields("lsh")
        With rs2
            .Edit
                !lsh = temlsh
                !ddh = ID
                !Date = Date
                !fhdwID = fhdwdm
                !hqID = hqID
                !yfdj = yfdj
                !ssdj = jjdj
                !zl = jjzl
            .Update
        End With
    End If
    Me.Refresh
    Call Form_Load
End Sub

Private Sub yfdj_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Set db1 = OpenDatabase(App.Path + "..\db\System.mdb")
        Set rs1 = db1.OpenRecordset("select yy.yycode from yy where yynumber =" + Chr$(34) + yfdj + Chr$(34) + ";")
        If rs1.EOF = False Then
            yfdj = UCase(rs1.Fields("yycode"))
            db1.Close
            yfsl.SetFocus
        Else
            MsgBox ("库中没有此烟叶信息！"), vbOKOnly, ("警告")
            db1.Close
            yfdj = ""
            yfdj.SetFocus
        End If
    End If
End Sub
Private Sub yfsl_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        yfzl.SetFocus
    End If
End Sub
Private Sub yfzl_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        sssl.SetFocus
    End If
End Sub
Private Sub sssl_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        sszl.SetFocus
    End If
End Sub
Private Sub sszl_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        jjdj.SetFocus
    End If
End Sub
Private Sub jjdj_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If jjdj <> "" Then
            Set db1 = OpenDatabase(App.Path + "..\db\System.mdb")
            Set rs1 = db1.OpenRecordset("select yy.yycode from yy where yynumber =" + Chr$(34) + jjdj + Chr$(34) + ";")
            If rs1.EOF = False Then
                jjdj = UCase(rs1.Fields("yycode"))
                db1.Close
                jjsl.SetFocus
            Else
                MsgBox ("库中没有此烟叶信息！"), vbOKOnly, ("警告")
                db1.Close
                jjdj = ""
                jjdj.SetFocus
            End If
        Else
            jjdj = UCase("Null")
            jjsl.SetFocus
        End If
    End If
End Sub
Private Sub jjsl_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If jjsl = "" Then
            jjsl = 0
        End If
        jjzl.SetFocus
    End If
End Sub
Private Sub jjzl_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If jjzl = "" Then
            jjzl = 0
        End If
        bc.Enabled = True
        bc.SetFocus
    End If
End Sub
Private Sub cxtj_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        cx.Enabled = True
        cx.SetFocus
    End If
End Sub
Private Sub bc_Click()
    Dim temcount As Integer
    temcount = 1
    Set rs = db.OpenRecordset("select dbd.ID from dbd where ID =" + Chr$(34) + ID.Text + Chr$(34) + ";")
    If rs.EOF = False Then
        MsgBox ("此调拨单已经存在！"), vbOKOnly, ("警告")
    Else
        If ID = "" Then
            MsgBox ("单据不能为空！"), vbOKOnly, ("警告")
        Else
            Set rs = db.OpenRecordset("dbd")
            With rs
                .AddNew
                !ID = ID
                !Date = Date
                !lsh = lsh
                !fhdwID = fhdwdm
                !hqID = hqID
                !yfsl = yfsl
                !yfzl = yfzl
                !yfdj = yfdj
                !sssl = sssl
                !sszl = sszl
                !ssdj = yfdj
                !jjsl = jjsl
                !jjzl = jjzl
                !jjdj = jjdj
                .Update
            End With
            If jjdj <> UCase("Null") Then
                Set rs2 = db.OpenRecordset("jjd")
                If rs2.EOF = False Then
                    rs2.MoveFirst
                    Do Until rs2.EOF
                        temcount = temcount + 1
                        rs2.MoveNext
                    Loop
                End If
                lsh = temcount
                With rs2
                    .AddNew
                        !lsh = temcount
                        !ddh = ID
                        !Date = Date
                        !fhdwID = fhdwdm
                        !hqID = hqID
                        !yfdj = yfdj
                        !ssdj = jjdj
                        !zl = jjzl
                    .Update
                End With
            End If
        End If
    End If
    lr.SetFocus
    Me.Refresh
    Call Form_Load
End Sub
Private Sub Form_Load()
    Dim count As Integer
    count = 0
    cx.Enabled = False
    bc.Enabled = False
    xgbc.Enabled = False
    ID = ""
    ID.Enabled = False
    Date = ""
    Date.Enabled = False
    fhdwdm = ""
    fhdwdm.Enabled = False
    fhdwmc = ""
    hqID = ""
    hqID.Enabled = False
    hqmc = ""
    yfsl = ""
    yfsl.Enabled = False
    yfzl = ""
    yfzl.Enabled = False
    yfdj = ""
    yfdj.Enabled = False
    sssl = ""
    sssl.Enabled = False
    sszl = ""
    sszl.Enabled = False
    jjsl = ""
    jjsl.Enabled = False
    jjzl = ""
    jjzl.Enabled = False
    jjdj = ""
    jjdj.Enabled = False
    Set db2 = OpenDatabase(App.Path + "\db\System.mdb")
    Set rs2 = db2.OpenRecordset("yy")
    rs2.MoveFirst
    temcount = 0
    Do Until rs2.EOF
        temcount = temcount + 1
        rs2.MoveNext
    Loop
    rs2.MoveFirst
    For n = 1 To temcount
        temyy = UCase(rs2.Fields("yycode"))
        yfdj.AddItem (temyy)
        jjdj.AddItem (temyy)
        rs2.MoveNext
    Next n
    db2.Close
    With MSF
        .Rows = 1
        .Col = 0: .Row = 0
        .ColWidth(0) = 400
        .Text = "序号"
        .Col = 1: .Row = 0
        .Text = "调拨单号"
        .Col = 2: .Row = 0
        .Text = "日期"
        .ColWidth(2) = 1000
        .Col = 3: .Row = 0
        .ColWidth(3) = 600
        .Text = "流水号"
        .Col = 4: .Row = 0
        .Text = "发货单位代码"
        .Col = 5: .Row = 0
        .ColWidth(5) = 1000
        .Text = "发货单位名称"
        .Col = 6: .Row = 0
        .Text = "货区代码"
        .Col = 7: .Row = 0
        .Text = "货区名称"
        .Col = 8: .Row = 0
        .Text = "原发等级"
        .Col = 9: .Row = 0
        .Text = "原发数量"
        .Col = 10: .Row = 0
        .Text = "原发重量"
        .Col = 11: .Row = 0
        .Text = "实收等级"
        .Col = 12: .Row = 0
        .Text = "实收数量"
        .Col = 13: .Row = 0
        .Text = "实收重量"
        .Col = 14: .Row = 0
        .Text = "降级等级"
        .Col = 15: .Row = 0
        .Text = "降级数量"
        .Col = 16: .Row = 0
        .Text = "降级重量"
    End With
    Set db = OpenDatabase(App.Path + "..\db\Data.mdb")
    Set rs = db.OpenRecordset("select * from dbd order by Int(lsh)")
    If rs.EOF = False Then
        rs.MoveFirst
        Do Until rs.EOF
            count = count + 1
            rs.MoveNext
        Loop
        With MSF
            rs.MoveFirst
            For i = 1 To count
                .AddItem Str(i)
                .Col = 1: .Row = i
                .Text = rs.Fields("ID")
                .Col = 2: .Row = i
                .Text = rs.Fields("Date")
                .Col = 3: .Row = i
                .Text = rs.Fields("lsh")
                .Col = 4: .Row = i
                .Text = rs.Fields("fhdwID")
                fhdwID1 = rs.Fields("fhdwID")
                .Col = 5: .Row = i
                Set db1 = OpenDatabase(App.Path + "..\db\System.mdb")
                Set rs1 = db1.OpenRecordset("select yz.yzmc from yz where yzID =" + Chr$(34) + fhdwID1 + Chr$(34) + ";")
                .Text = rs1.Fields("yzmc")
                db1.Close
                .Col = 6: .Row = i
                .Text = rs.Fields("hqID")
                hqID1 = rs.Fields("hqID")
                .Col = 7: .Row = i
                Set db1 = OpenDatabase(App.Path + "..\db\System.mdb")
                Set rs1 = db1.OpenRecordset("select hq.hqmc from hq where hqID =" + Chr$(34) + hqID1 + Chr$(34) + ";")
                .Text = rs1.Fields("hqmc")
                db1.Close
                .Col = 8: .Row = i
                .Text = UCase(rs.Fields("yfdj"))
                .Col = 9: .Row = i
                .Text = rs.Fields("yfsl")
                .Col = 10: .Row = i
                .Text = rs.Fields("yfzl")
                .Col = 11: .Row = i
                .Text = UCase(rs.Fields("ssdj"))
                .Col = 12: .Row = i
                .Text = rs.Fields("sssl")
                .Col = 13: .Row = i
                .Text = rs.Fields("sszl")
                .Col = 14: .Row = i
                .Text = UCase(rs.Fields("jjdj"))
                .Col = 15: .Row = i
                .Text = rs.Fields("jjsl")
                .Col = 16: .Row = i
                .Text = rs.Fields("jjzl")
                rs.MoveNext
            Next i
        End With
    End If
    lsh = count + 1
End Sub