module.bas

一个简单但功能强大的进货系统,同样适合用于毕业论文的设计

Attribute VB_Name = "Module"
Public user As String
Public post As String
Public dteSysDate As Date


Public Sub main()

    
    frmLogin.Show vbModal
    If Not frmLogin.LoginSucceeded Then
        End
    End If
    Unload frmLogin
    
    frmMDI.Show
    
    frmSysDate.Show vbModal
    
End Sub


Public Function ConnectString() As String
    
    ConnectString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=ACCP进销存"

End Function

Public Function ExecuteSQL(ByVal sql As String) As ADODB.Recordset

    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    
    On Error GoTo ExecuteSQL_Error
    
    Set cnn = New Connection
    cnn.Open ConnectString
    If InStr("INSERT,DELETE,UPDATE", UCase$(sql)) Then
        cnn.Execute sql
    Else
        Set rst = New Recordset
        rst.Open Trim$(sql), cnn, adOpenKeyset, adLockOptimistic
        Set ExecuteSQL = rst
    End If
    
ExecuteSQL_Exit:
    Set rst = Nothing
    Set cnn = Nothing
    Exit Function
    
ExecuteSQL_Error:
    MsgBox "查询错误:" & Err.Description, vbCritical + vbOKOnly, "ACCP进销存管理系统"
    Resume ExecuteSQL_Exit
End Function

Public Sub EnterToTab(Keyasc As Integer)

    If Keyasc = 13 Then
        SendKeys "{TAB}"
    End If

End Sub

Public Function Product_Status(strProNum As String) As String
    Dim rsProSta As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngOrdQty, sngSalQty As Single
    Dim CurOrdPrice, CurSalPrice As Currency
    Set rsProSta = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset

    strSQL = "select a.商品名称,a.规格型号,b.数量,b.总额 from 商品表 a,盘点表 b where a.商品编号=b.商品编号 and a.商品编号='" & strProNum & "'"
    rsProSta.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly

    strSQL = "select 商品编号,sum(数量) as oqty,sum(总额) as oprice from 库存表_tmp where 商品编号='" & strProNum & "' group by 商品编号"
    rsOrdDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    strSQL = "select 商品编号,sum(数量) as sqty,sum(总额) as sprice from 出库表_tmp where 商品编号='" & strProNum & "' group by 商品编号"
    
    rsSalDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    
    
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
            CurOrdPrice = !oprice
        Else
            sngOrdQty = 0
            CurOrdPrice = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
            CurSalPrice = !sprice
        Else
            sngSalQty = 0
            CurSalPrice = 0
        End If
    End With
    If rsProSta.RecordCount = 0 Then
        Product_Status = ""
    Else
        With rsProSta
            .MoveFirst
            strSQL = !商品名称 & "     " & !规格型号 & "     数量:" & sngOrdQty + !数量 - sngSalQty & "     金额:" & CurOrdPrice + !总额 - CurSalPrice
        End With
        Product_Status = strSQL
    End If
    rsProSta.Close
    Set rsProSta = Nothing
End Function


Public Function SaleTooLarge(strSaleID As String, strSalPro As String, strSalQty As String) As Boolean
    Dim rsMatQty As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngMatQty, sngOrdQty, sngSalQty As Single
    Set rsMatQty = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset
    strSQL = "select 数量 from 盘点表 where 商品编号='" & strSalPro & "'"
    rsMatQty.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    strSQL = "select 商品编号,sum(数量) as oqty from 库存表_tmp where 商品编号='" & strSalPro & "' group by 商品编号"
    rsOrdDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    strSQL = "select 商品编号,sum(数量) as sqty from 出库表_tmp where 商品编号='" & strSalPro & "' and 出库编号<>'" & strSaleID & "' group by 商品编号"
    rsSalDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
        Else
            sngOrdQty = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
        Else
            sngSalQty = 0
        End If
    End With
    If rsMatQty.RecordCount = 0 Then
        sngMatQty = 0
    Else
        With rsMatQty
            .MoveFirst
            sngMatQty = CSng(!数量)
        End With
    End If
    If (sngOrdQty + sngMatQty - sngSalQty) - CCur(strSalQty) < 0 Then
        SaleTooLarge = False
    Else
        SaleTooLarge = True
    End If
    rsMatQty.Close
    Set rsMatQty = Nothing
End Function

Public Function SaleUnPr(strSaleID As String, strSalPro As String) As Currency
    Dim rsMat As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngOrdQty, sngSalQty As Single
    Dim CurOrdPrice, CurSalPrice As Currency
    Set rsMat = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset
    strSQL = "select 数量,总额 from 盘点表 where 商品编号='" & strSalPro & "'"
    rsMat.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    strSQL = "select 商品编号,sum(数量) as oqty,sum(总额) as oprice from 库存表_tmp where 商品编号='" & strSalPro & "' group by 商品编号"
    rsOrdDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    strSQL = "select 商品编号,sum(数量) as sqty,sum(总额) as sprice from 出库表_tmp where 商品编号='" & strSalPro & "' and 出库编号<>'" & strSaleID & "' group by 商品编号"
    rsSalDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
            CurOrdPrice = !oprice
        Else
            sngOrdQty = 0
            CurOrdPrice = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
            CurSalPrice = !sprice
        Else
            sngSalQty = 0
            CurSalPrice = 0
        End If
    End With
    With rsMat
        If rsMat.RecordCount = 0 Then
            SaleUnPr = 0
        Else
            If sngOrdQty + CSng(!数量) - sngSalQty <> 0 Then
                SaleUnPr = CCur(Round((CurOrdPrice + CCur(!总额) - CurSalPrice) _
                / (sngOrdQty + CSng(!数量) - sngSalQty), 2))
            End If
        End If
    End With
    rsMat.Close
    rsOrdDA.Close
    rsSalDA.Close
    Set rsMat = Nothing
    Set rsOrdDA = Nothing
    Set rsSalDA = Nothing
End Function



Public Function Sale_Price(strSaleID As String, strSaleNum As String, strSaleUnPr As String, strSaleQty As String) As Currency
    Dim rsMatSale As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngOrdQty, sngSalQty As Single
    Dim CurOrdPrice, CurSalPrice As Currency
    Set rsMatSale = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset
    strSQL = "select 数量,总额 from 盘点表 where 商品编号='" & strSaleNum & "'"
    rsMatSale.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    strSQL = "select 商品编号,sum(数量) as oqty,sum(总额) as oprice from 库存表_tmp where 商品编号='" & strSaleNum & "' group by 商品编号"
    rsOrdDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    strSQL = "select 商品编号,sum(数量) as sqty,sum(总额) as sprice from 出库表_tmp where 商品编号='" & strSaleNum & "' and 出库编号<>'" & strSaleID & "'group by 商品编号"
    rsSalDA.Open strSQL, DEaccp.Conaccp, adOpenStatic, adLockReadOnly
    
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
            CurOrdPrice = !oprice
        Else
            sngOrdQty = 0
            CurOrdPrice = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
            CurSalPrice = !sprice
        Else
            sngSalQty = 0
            CurSalPrice = 0
        End If
    End With
    With rsMatSale
        If .RecordCount <> 0 Then
            If (sngOrdQty + CSng(!数量) - sngSalQty) - CSng(strSaleQty) < 0.00000001 Then
                Sale_Price = CurOrdPrice + CCur(!总额) - CurSalPrice
            Else
                Sale_Price = Round((CCur(strSaleUnPr) * CSng(strSaleQty)), 2)
            End If
        End If
    End With
    rsMatSale.Close
    rsOrdDA.Close
    rsSalDA.Close
    Set rsMatSale = Nothing
    Set rsOrdDA = Nothing
    Set rsSalDA = Nothing
End Function