frmsell.frm

一个小型的进销存管理软件,数据采用ACCE

Private Sub Grid_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Rst As ADODB.Recordset
Dim Cmd As ADODB.Command
Dim SQL As String
Dim I As Integer
Dim N As Integer
Dim JZF As Integer

    Select Case KeyCode
        Case vbKeyF1
            Call Command2_Click
        Case vbKeyF2
            FrmSPLB.Show 1
        Case vbKeyF3
            If MsgBox("请确信要取消此单?", vbOKCancel + vbCritical, "提示") = vbOK Then
                Call ReSet
            End If
        Case vbKeyF8
            If Grid.Rows <= 1 Then Exit Sub
                  
            Dim Rst1, Rst2, KCRst As ADODB.Recordset
            Dim NumId, id As Integer
            
            If TxtSHR.Caption = "" Then
                MsgBox "请选择收货人（单位）！", vbOKOnly + 48, "提示"
                Exit Sub
            End If
            If Combo1.Text = "" Then
                MsgBox "请选择付款方式！", vbOKOnly + vbCritical, "提示"
                Exit Sub
            Else
                If Combo1.Text = "现金" Then
                    JZF = 1
                Else
                    JZF = 0
                End If
            End If
            
            For I = 1 To Grid.Rows - 1
                If Grid.TextMatrix(I, 5) = "0" Then
                    MsgBox "第" & I & "行'数量'不能为零！", vbOKOnly + vbExclamation, "警告"
                    Exit Sub
                ElseIf Grid.TextMatrix(I, 6) = "0.00" Then
                    MsgBox "第" & I & "行'单价'不能为零！", vbOKOnly + vbExclamation, "警告"
                    Exit Sub
                End If
            Next I
            
            '更新入库单总表，插入一条
            '--------------------------------------------------------------------------------------
            Set Rst = New ADODB.Recordset
                SQL = "insert into XSD_ZB values ('" & LblFPHM.Caption & "','" _
                  & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & TxtSHR.Caption & "','" & _
                  lblJE.Caption & "','" & lblSE.Caption & "','" & lblJSHJ.Caption & "','0','" & Combo1.Text & "','" & JZF & "' )"
                Rst.Open SQL, db, 1, 3
            '---------------------------------------------------------------------------------------
            
            '更新入库单明细表
            '---------------------------------------------------------------------------------------
            Set Rst1 = New ADODB.Recordset
                SQL = "select max(id) from xsd_mx"
                Rst1.Open SQL, db, 1, 3
                If IsNull(Rst1.Fields(0)) Then
                    NumId = 0
                Else
                    NumId = Rst1.Fields(0)
                End If
                
            Set Rst2 = New ADODB.Recordset
            For I = 1 To Grid.Rows - 1
                NumId = NumId + 1
                SQL = "insert into xsd_mx  values('" & NumId & "','" & LblFPHM.Caption & "','" & Grid.TextMatrix(I, 0) & "','" _
                  & Grid.TextMatrix(I, 1) & "','" & Grid.TextMatrix(I, 2) & "','" & Grid.TextMatrix(I, 3) & "','" _
                  & Grid.TextMatrix(I, 4) & "','" & Grid.TextMatrix(I, 5) & "','" & Grid.TextMatrix(I, 6) & "','" _
                  & Grid.TextMatrix(I, 7) & "','" & Grid.TextMatrix(I, 8) & "','" & Grid.TextMatrix(I, 9) & "','" _
                  & Grid.TextMatrix(I, 10) & "','" & Grid.TextMatrix(I, 11) & "')"
                Rst2.Open SQL, db, 1, 3
            
            '更新动态库存表
            '---------------------------------------------------------------------------------------
                Set KCRst = New ADODB.Recordset
                    SQL = "update  kcdtb set sl=sl-" & Val(Grid.TextMatrix(I, 5)) & " where spid=" & Grid.TextMatrix(I, 11)
                    KCRst.Open SQL, db, 1, 3
                    
'                    KCRst.Fields(4) = KCRst.Fields(4) - Val(Grid.TextMatrix(I, 5))
'                    KCRst.Update
            '---------------------------------------------------------------------------------------
            Next
            '---------------------------------------------------------------------------------------
            If ButtonFlag = 1 Then
                If MsgBox("数据保存成功,是否要打印?", vbOKCancel + vbInformation, "提示") = vbOK Then
                    Call FPPrint
                End If
            ElseIf ButtonFlag = 2 Then
                MsgBox "数据保存成功,正在打印！", , "提示"
                Call FPPrint
            End If
                
            'Combo1.Text = ""
            
            Call ReSet
            Number = Number + 1
            LblFPHM.Caption = Format(Date$, "yymmdd") & Format(CStr(Number), "000")
        Case vbKeyF10
            If Grid.Rows <= 1 Then
                MsgBox "数据内容为空，不能打印！", vbOKOnly + vbCritical, "警告"
                Exit Sub
            End If
            Call Grid_KeyUp(vbKeyF8, 0)
        Case vbKeyDelete, vbKeyBack
          Dim SumJE, SumSE, SumJSHJ As Currency
          Dim SumSL As Integer
          
          If Grid.RowSel = 0 Then Exit Sub
          If Grid.Rows = 2 Then ReSet: Exit Sub
          IDlist.Remove Grid.RowSel
          Grid.RemoveItem Grid.RowSel
          For I = 1 To Grid.Rows - 1
              SumJE = SumJE + Val(Grid.TextMatrix(I, 7))
              SumSE = SumSE + Val(Grid.TextMatrix(I, 9))
              SumJSHJ = SumJSHJ + Val(Grid.TextMatrix(I, 10))
              SumSL = SumSL + Val(Grid.TextMatrix(I, 5))
          Next
            
          lblJE.Caption = Format(CStr(SumJE), "##0.00")
          lblSE.Caption = Format(CStr(SumSE), "##0.00")
          lblJSHJ.Caption = Format(CStr(SumJSHJ), "##0.00")
          lblSL.Caption = SumSL
          
          For I = 1 To Grid.Rows - 1
            Grid.TextMatrix(I, 0) = CStr(I)
          Next
    End Select
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case Is = "Exit"
            Unload Me
        Case Is = "Addline"
            FrmSPLB.Show 1
        Case Is = "Delline"
            Call Grid_KeyUp(vbKeyDelete, 0)
        Case Is = "Save"
            ButtonFlag = 1
            Call Grid_KeyUp(vbKeyF8, 0)
        Case Is = "Print"
            ButtonFlag = 2
            Call Grid_KeyUp(vbKeyF10, 0)
    End Select
    
End Sub
Private Sub TxtSHR_DblClick()
    Call Command2_Click
End Sub
Private Sub FPPrint()
Dim t As Integer
Dim j As Integer
Dim N As Integer
Dim RstKH As ADODB.Recordset
    On Error GoTo Errorhandler

    Set XSDExcel = New Excel.Application
        XSDExcel.Visible = False
        Set XSDExcel = Nothing
        XSDExcel.SheetsInNewWorkbook = 1
            Set zsbworkbook = XSDExcel.Workbooks.Open(App.Path + "\" + "sheet\xsfp.xlt")
            With XSDExcel.ActiveSheet
                '--------------------------------------填充客户资料
                Set RstKH = New Recordset
                    SQL = "select * from kh where khmc='" & TxtSHR.Caption & "'"
                    RstKH.Open SQL, db, 1, 3
                    
                .Range("F3").Value = RstKH.Fields(1)
                .Range("F4").Value = RstKH.Fields(2)
                .Range("F5").Value = RstKH.Fields(3)
                .Range("F6").Value = "M.B.: " & RstKH.Fields(4)
                
                RstKH.Close
                Set RstKH = Nothing
                '-----------------------------------------
                
                If Combo1.Text = "现金" Then
                    .Range("D9").Value = "GOTOVINA"
                Else
                    .Range("D9").Value = "Waiting...."
                End If
                
                .Range("C11").Value = LblFPHM.Caption
                .Range("F11").Value = DTPicker1.Value
                
                N = 12 + Grid.Rows
                'If n > 40 Then
                'End If
                j = 1
                For t = 14 To N
                        a = "A" + CStr(t)
                        .Range(a).Value = Grid.TextMatrix(j, 0)
                        b = "B" + CStr(t)
                        .Range(b).Value = Grid.TextMatrix(j, 1)
                        c = "C" + CStr(t)
                        .Range(c).Value = "KOM"
                        d = "D" + CStr(t)
                        .Range(d).Value = Grid.TextMatrix(j, 5)
                        e = "E" + CStr(t)
                        .Range(e).Value = Grid.TextMatrix(j, 6)
                        f = "F" + CStr(t)
                        .Range(f).Value = Grid.TextMatrix(j, 7)
                        g = "G" + CStr(t)
                        .Range(g).Value = "22%"
                        h = "H" + CStr(t)
                        .Range(h).Value = Grid.TextMatrix(j, 9)
                        I = "I" + CStr(t)
                        .Range(I).Value = Grid.TextMatrix(j, 10)
                    j = j + 1
                Next t
                .Range("F54").Value = lblJE.Caption
                .Range("G54").Value = "22%"
                .Range("H54").Value = lblSE.Caption
                .Range("I54").Value = lblJSHJ.Caption
            End With
  'dd = MsgBox("yes or no", vbYesNo + vbSystemModal)
  'If dd = vbNo Then Exit Sub
     XSDExcel.ActiveSheet.PageSetup.Orientation = xlPortrait       'xlLandscape
     XSDExcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
     XSDExcel.Caption = "打印预览"
     XSDExcel.ActiveWindow.SelectedSheets.PrintPreview
     XSDExcel.ActiveSheet.PrintOut
     XSDExcel.DisplayAlerts = False
     XSDExcel.Quit
     XSDExcel.DisplayAlerts = True
     Set XSDExcel = Nothing
  Exit Sub
Errorhandler:
    MsgBox "请正确安装EXCEL或检查打印机状况！", vbOKOnly + vbCritical
    Exit Sub
End Sub

Private Sub Text1_LostFocus()
On Error GoTo Errorhandler
    Dim SumJE, SumSE, SumJSHJ As Currency
    Dim I, SumSL As Integer
    Dim tmpRow As Integer
    Dim tmpCol As Integer
    ' Save current settings of Grid Row and col. This is needed only if
    ' the focus is set somewhere else in the Grid.
    tmpRow = Grid.Row
    tmpCol = Grid.Col
    ' Set Row and Col back to what they were before Text1_LostFocus:
    Grid.Row = gRow
    Grid.Col = gCol
    If gCol = 5 Then
        '检测库存商品数量
        Dim KCSLRst As ADODB.Recordset
        
        Set KCSLRst = New ADODB.Recordset
            SQL = "select * from kcdtb where spid=" & Grid.TextMatrix(Grid.RowSel, 11)
            KCSLRst.Open SQL, db, 1, 3
            
            If IsNull(KCSLRst.Fields(4)) Or KCSLRst.EOF Then
                MsgBox "仓库中无此商品，请确认！", vbOKOnly + 48, "提示"
                GoTo MOVEOut
            End If
            If Val(KCSLRst.Fields(4)) >= Val(Text1.Text) Then
                  Grid.Text = Val(Text1.Text)
            Else
                MsgBox "该商品库存数量不足！", vbOKOnly + 48, "提示"
                GoTo MOVEOut
            End If
    ElseIf gCol = 6 Then
        Grid.Text = Format(Val(Text1.Text), "###0.00") ' Transfer text back to grid.
    ElseIf gCol = 8 Then
        If MsgBox("你确信要更改ＰＤＶ？", vbOKCancel + vbCritical, "提示") = vbOK Then
            Grid.Text = Val(Text1.Text)
        End If
    End If

    ' Return row and Col contents:
      Grid.TextMatrix(Grid.RowSel, 7) = Format(Val(Grid.TextMatrix(Grid.RowSel, 6) * Grid.TextMatrix(Grid.RowSel, 5)), "0.00")
      Grid.TextMatrix(Grid.RowSel, 9) = Format(Val(Grid.TextMatrix(Grid.RowSel, 7) * Grid.TextMatrix(Grid.RowSel, 8)), "0.00")
      Grid.TextMatrix(Grid.RowSel, 10) = Format(Val(Val(Grid.TextMatrix(Grid.RowSel, 7)) + Val(Grid.TextMatrix(Grid.RowSel, 9))), "0.00")
    
    For I = 1 To Grid.Rows - 1
        SumJE = SumJE + Val(Grid.TextMatrix(I, 7))
        SumSE = SumSE + Val(Grid.TextMatrix(I, 9))
        SumJSHJ = SumJSHJ + Val(Grid.TextMatrix(I, 10))
        SumSL = SumSL + Val(Grid.TextMatrix(I, 5))
    Next
    
    lblJE.Caption = Format(CStr(SumJE), "0.00")
    lblSE.Caption = Format(CStr(SumSE), "0.00")
    lblJSHJ.Caption = Format(CStr(SumJSHJ), "0.00")
    lblSL.Caption = SumSL
MOVEOut:
    Text1.SelStart = 0 ' Return caret to beginning.
    Text1.Visible = False ' Disable text box.
    
    Grid.Row = tmpRow
    Grid.Col = tmpCol
    Exit Sub
Errorhandler:
    Exit Sub
End Sub