frminupdate.frm

这个是基于vb的物资信息管理系统

            Text6.Text = MSFlexGrid1.TextMatrix(i, 7)
            Text6.Text = ""
            MSFlexGrid1.TextMatrix(i, 7) = Text6.Text
            For j = i To (MSFlexGrid1.Rows - 2)
                MSFlexGrid1.TextMatrix(j, 0) = MSFlexGrid1.TextMatrix(j + 1, 0)
                MSFlexGrid1.TextMatrix(j, 1) = MSFlexGrid1.TextMatrix(j + 1, 1)
                MSFlexGrid1.TextMatrix(j, 2) = MSFlexGrid1.TextMatrix(j + 1, 2)
                MSFlexGrid1.TextMatrix(j, 3) = MSFlexGrid1.TextMatrix(j + 1, 3)
                MSFlexGrid1.TextMatrix(j, 4) = MSFlexGrid1.TextMatrix(j + 1, 4)
                MSFlexGrid1.TextMatrix(j, 5) = MSFlexGrid1.TextMatrix(j + 1, 5)
                MSFlexGrid1.TextMatrix(j, 6) = MSFlexGrid1.TextMatrix(j + 1, 6)
                MSFlexGrid1.TextMatrix(j, 7) = MSFlexGrid1.TextMatrix(j + 1, 7)
            Next j
            MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1
            If MSFlexGrid1.Rows = 1 Then
                cmdDelRecord.Enabled = False
            End If
        End If
    End If
End Sub

Private Sub cmdEdit_Click()
    Dim i As Integer
    Dim mrc1 As Recordset, mrc2 As Recordset
    Dim SQLstring As String
    Dim mrc As Recordset, mrcc As Recordset
    Dim Num As Integer, price As Single
    Dim str As String
    
    If Text2.Text = "" Then
        MsgBox "发票号码不能为空，请填写！", vbOKOnly + vbExclamation, "警告"
        Text2.SetFocus
        Exit Sub
    End If
    If Text3.Text = "" Then
        MsgBox "进库日期不能为空，请填写！", vbOKOnly + vbExclamation, "警告"
        Text3.SetFocus
        Exit Sub
    Else
        If IsDate(Text3.Text) Then
            Text3 = Format(Text3, "yyyy-mm-dd")
        Else
            MsgBox "进库时间格式应为：yyyy-mm-dd", vbOKOnly + vbExclamation, "警告"
            Text3.Text = ""
            Text3.SetFocus
            Exit Sub
        End If
    End If
    Set mrc1 = Mydb.OpenRecordset("select * from inlib where 进库单号码='" & Trim(Text1) & "'")
    mrc1.Delete
    Set mrc2 = Mydb.OpenRecordset("select * from inlibdetail where 进库单号码='" & Trim(Text1) & "'")
    While mrc2.EOF = False
        str = mrc2.Fields("材料编码")
        Num = mrc2.Fields("数量")
        price = mrc2.Fields("金额")
        SQLstring = "update msurplus set 数量=数量-" + CStr(Num) + ",金额=金额-" + CStr(price) + " where 材料编码='" & str & "'"
        Mydb.Execute (SQLstring)
       
        mrc2.Delete
        mrc2.MoveNext
    Wend
    
    If MSFlexGrid1.Rows > 1 Then
        mrc1.AddNew
        mrc1.Fields("进库单号码") = Text1.Text
        mrc1.Fields("发票号码") = Text2.Text
        mrc1.Fields("进库日期") = Text3.Text
        If Text4.Text = "" Then
            mrc1.Fields("经办人") = Null
        Else
            mrc1.Fields("经办人") = Text4.Text
        End If
        If Text5.Text = "" Then
            mrc1.Fields("保管人") = Null
        Else
            mrc1.Fields("保管人") = Text5.Text
        End If
        mrc1.Update
        For i = 1 To (MSFlexGrid1.Rows - 1)
            mrc2.AddNew
            mrc2.Fields("进库单号码") = Text1.Text
            mrc2.Fields("材料编码") = MSFlexGrid1.TextMatrix(i, 0)
            mrc2.Fields("数量") = Val(MSFlexGrid1.TextMatrix(i, 4))
            If MSFlexGrid1.TextMatrix(i, 5) = "" Then
                mrc2.Fields("单价") = Null
            Else
                mrc2.Fields("单价") = Val(MSFlexGrid1.TextMatrix(i, 5))
            End If
            mrc2.Fields("金额") = Val(MSFlexGrid1.TextMatrix(i, 6))
            If MSFlexGrid1.TextMatrix(i, 7) = "" Then
                mrc2.Fields("备注") = Null
            Else
                mrc2.Fields("备注") = MSFlexGrid1.TextMatrix(i, 7)
            End If
            mrc2.Update
            SQLstring = "select * from msurplus where 材料编码='" & MSFlexGrid1.TextMatrix(i, 0) & "'"
            Set mrc = Mydb.OpenRecordset(SQLstring)
            '如果材料余额表中没有当前材料编码的记录，就添加
            If mrc.EOF = True Then
                mrc.Close
                SQLstring = "select * from msurplus"
                Set mrcc = Mydb.OpenRecordset(SQLstring)
                mrcc.AddNew
                mrcc.Fields("材料编码") = MSFlexGrid1.TextMatrix(i, 0)
                mrcc.Fields("数量") = 0
                If MSFlexGrid1.TextMatrix(i, 5) = "" Then
                    mrcc.Fields("单价") = Null
                Else
                    mrcc.Fields("单价") = MSFlexGrid1.TextMatrix(i, 5)
                End If
                mrcc.Fields("金额") = 0
                mrcc.Fields("备注") = Null
                mrcc.Update
                mrcc.Close
            Else
                mrc.Close
            End If
            Num = Val(MSFlexGrid1.TextMatrix(i, 4))
            price = Val(MSFlexGrid1.TextMatrix(i, 6))
            SQLstring = "update msurplus set 数量=数量+" + CStr(Num) + ",金额=金额+" + CStr(price) + " where 材料编码='" & MSFlexGrid1.TextMatrix(i, 0) & "'"
            Mydb.Execute (SQLstring)
        Next i
        mrc1.Close
        mrc2.Close
        Unload Me
        Project.StatusBar1.Panels(2).Text = "就绪"
        Exit Sub
    Else
        MsgBox "进库单中必须至少包含一项材料明细。" & vbCrLf & "此进库单中未填写材料信息，请填写。", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    End If
        
End Sub

Private Sub cmdFind_Click()
    MSFlexGrid1.Rows = 1
    Dim mrc1 As Recordset, mrc2 As Recordset
    InPaperId = ""
    Project.StatusBar1.Panels(2).Text = "查找进库信息"
    InFind.Show 1
    If InPaperId <> "" Then
        Text1.Text = InPaperId
        Set mrc1 = Mydb.OpenRecordset("select * from inlib where 进库单号码='" & Trim(Text1) & "'")
        Set mrc2 = Mydb.OpenRecordset("select * from goods,inlibdetail where 进库单号码='" & Trim(Text1) & "' and 材料编码=Goodsid")
        Text2.Text = mrc1.Fields("发票号码")
        Text3.Text = mrc1.Fields("进库日期")
        If IsNull(mrc1.Fields("经办人")) Then
            Text4.Text = ""
        Else
            Text4.Text = mrc1.Fields("经办人")
        End If
        If IsNull(mrc1.Fields("保管人")) Then
            Text5.Text = ""
        Else
            Text5.Text = mrc1.Fields("保管人")
        End If
        While mrc2.EOF = False
            MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
            MSFlexGrid1.Row = MSFlexGrid1.Rows - 1
            MSFlexGrid1.Col = 0
            MSFlexGrid1.Text = mrc2.Fields("材料编码")
            MSFlexGrid1.Col = 1
            MSFlexGrid1.Text = mrc2.Fields("GoodsName")
            MSFlexGrid1.Col = 2
            MSFlexGrid1.Text = mrc2.Fields("Type")
            MSFlexGrid1.Col = 3
            MSFlexGrid1.Text = mrc2.Fields("Unit")
            MSFlexGrid1.Col = 4
            MSFlexGrid1.Text = mrc2.Fields("数量")
            MSFlexGrid1.Col = 5
            If IsNull(mrc2.Fields("单价")) Then
                MSFlexGrid1.Text = ""
            Else
                MSFlexGrid1.Text = mrc2.Fields("单价")
            End If
            MSFlexGrid1.Col = 6
            MSFlexGrid1.Text = mrc2.Fields("金额")
            MSFlexGrid1.Col = 7
            If IsNull(mrc2.Fields("备注")) Then
                MSFlexGrid1.Text = ""
            Else
                MSFlexGrid1.Text = mrc2.Fields("备注")
            End If
            mrc2.MoveNext
        Wend
        mrc1.Close
        mrc2.Close
        cmdEdit.Enabled = True
        cmdDel.Enabled = True
        cmdAddRecord.Enabled = True
        cmdDelRecord.Enabled = True
        Text1.Enabled = False
    Else
        cmdEdit.Enabled = False
        cmdDel.Enabled = False
        cmdAddRecord.Enabled = False
        cmdDelRecord.Enabled = False
    End If
End Sub

Private Sub cmdInfo_Click()
    MsgBox "编辑进库单必须先定位一个进库记录，系统需" & vbCrLf & "要定位库中的一个记录。如果您想改变进库" & vbCrLf & "单，请按查找按钮，从弹出的窗口列表中选定" & vbCrLf & "一个进库记录，然后执行“修改”或“删除”操作。" & vbCrLf & "在这张表中，您也可以设置条件来查找。", vbOKOnly + vbInformation, "详细信息"
End Sub

Private Sub Form_Activate()
    Project.StatusBar1.Panels(2).Text = "编辑进库单"
End Sub

Private Sub Form_Load()
    MSFlexGrid1.Cols = 8
    MSFlexGrid1.Rows = 1
    MSFlexGrid1.Row = 0
    MSFlexGrid1.Col = 0
    MSFlexGrid1.Text = "材料编码"
    MSFlexGrid1.Col = 1
    MSFlexGrid1.Text = "材料名称"
    MSFlexGrid1.Col = 2
    MSFlexGrid1.Text = "规格型号"
    MSFlexGrid1.Col = 3
    MSFlexGrid1.Text = "计量单位"
    MSFlexGrid1.Col = 4
    MSFlexGrid1.Text = "数量"
    MSFlexGrid1.Col = 5
    MSFlexGrid1.Text = "单价"
    MSFlexGrid1.Col = 6
    MSFlexGrid1.Text = "金额"
    MSFlexGrid1.Col = 7
    MSFlexGrid1.Text = "备注"
    Text6.Visible = False
    cmdDelRecord.Enabled = False
    cmdAddRecord.Enabled = False
    cmdEdit.Enabled = False
    cmdDel.Enabled = False
    Set Myws = DBEngine.Workspaces(0)
    Set Mydb = Myws.OpenDatabase(App.Path + "\store.mdb")
    Set Myrs1 = Mydb.OpenRecordset("select * from inlib")
    Set Myrs2 = Mydb.OpenRecordset("select * from inlibdetail")
End Sub

Private Sub MSFlexGrid1_Click()
    Dim c As Integer
    Dim r As Integer
    
    With MSFlexGrid1
        c = .Col
        r = .Row
        Text6.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(c)
        Text6.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(r)
        If .Appearance = 1 Then
            Text6.Left = Text6.Left + 2 * Screen.TwipsPerPixelX
            Text6.Top = Text6.Top + 2 * Screen.TwipsPerPixelY
        End If
        Text6.Width = .ColWidth(c)
        Text6.Height = .RowHeight(r)
        Text6.Text = .Text
    End With
    Text6.Visible = True
    Text6.SetFocus
End Sub


Private Sub MSFlexGrid1_Scroll()
    Text6.Visible = False
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Text2.SetFocus
    End If
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Text3.SetFocus
    End If
End Sub

Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Text4.SetFocus
    End If
End Sub

Private Sub Text4_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Text5.SetFocus
    End If
End Sub

Private Sub Text5_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        cmdEdit.SetFocus
    End If
End Sub

Private Sub Text6_Change()
    MSFlexGrid1.Text = Text6.Text
End Sub

Private Sub Text6_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        Text6.Visible = False
    End If
End Sub

Private Sub Text6_LostFocus()
    Text6.Visible = False
End Sub