frmrptmat.frm

里面的内容包括：基盘存管理本信息管理库存管理入库管理出库管理等功能

Private Sub TxtDay_KeyPress(KeyAscii As Integer)
    Dim strValid As String
    strValid = "0123456789"
    If KeyAscii > 26 Then
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    ElseIf KeyAscii = 13 Then
            CmdRpt(0).SetFocus
    End If
End Sub

Private Sub TxtMonth_KeyPress(KeyAscii As Integer)
    Dim strValid As String
    strValid = "0123456789"
    If KeyAscii > 26 Then
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    ElseIf KeyAscii = 13 Then
        If TxtDay.Enabled = True Then
            TxtDay.SelStart = 0
            TxtDay.SelLength = Len(TxtYear.Text)
            TxtDay.SetFocus
        Else
            CmdRpt(0).SetFocus
        End If
    End If
End Sub

Private Sub TxtYear_KeyPress(KeyAscii As Integer)
    Dim strValid As String
    strValid = "0123456789"
    If KeyAscii > 26 Then
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    ElseIf KeyAscii = 13 Then
        If TxtMonth.Enabled = True Then
            TxtMonth.SelStart = 0
            TxtMonth.SelLength = Len(TxtYear.Text)
            TxtMonth.SetFocus
        Else
            CmdRpt(0).SetFocus
        End If
    End If
End Sub

Private Function DateIsTrue(strYear As String, strMonth As String, strDay As String) As Boolean
    Dim strdate As String
    Dim strSQL As String
    If OptRptType(0).Value = True Then
        strdate = strYear & "-" & strMonth & "-" & strDay
    ElseIf OptRptType(1).Value = True Then
        strdate = strYear & "-" & strMonth
    Else
        strdate = strYear & "-12"
    End If
    If IsDate(strdate) Then
        rsRpt.Open "select * from r_parameter", DEjxc.Conjxc, adOpenStatic, adLockReadOnly
        With rsRpt
            .MoveFirst
            If strDay <> "" Then
                If CDate(strdate) >= !pass_date Then
                    DateIsTrue = True
                Else
                    DateIsTrue = False
                End If
            Else
                If CDate(Format(strdate, "yyyy-mm")) >= Format(!pass_date, "yyyy-mm") Then
                    DateIsTrue = True
                Else
                    DateIsTrue = False
                End If
            End If
        End With
        rsRpt.Close
    Else
        DateIsTrue = False
    End If
End Function

Private Sub Mat_Rpt()
    Dim strSQL As String
    Dim dteDate As Date
    Dim strY, strM, strD As String
    strSQL = "delete from rpt_mat"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "select p_id,product_name,product_model,unit," & _
    "unit_price,matbegqty as begqty,matbegprice " & _
    "as begprice,orderqty as oqty,orderprice as oprice,saleqty as sqty," & _
    "saleprice as sprice,matendqty,matendprice into temp_mat from rpt_mat"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    If OptRptType(0).Value = True Then
        dteDate = CDate(TxtYear.Text & "-" & TxtMonth.Text & "-" & TxtDay.Text)
    ElseIf OptRptType(1).Value = True Then
        dteDate = CDate(TxtYear.Text & "-" & TxtMonth.Text)
    ElseIf OptRptType(2).Value = True Then
        dteDate = CDate(TxtYear.Text & "-09")
    End If
    strY = CStr(Year(dteDate))
    strM = Format(CStr(Month(dteDate)), "0#")
    If OptRptType(0).Value = True Then
        strSQL = "insert into temp_mat select p_id,qty" & Right(strY, 2) & strM & _
        " as begqty,price" & Right(strY, 2) & strM & " as begprice from mat_head" _
        & " where p_id in (select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "')"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as oqty" & _
        ",sum(price) as oprice from order_detail_b where p_id in " & _
        "(select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and (order_id in (select ps_id from " & _
        "ps_head_b where ps_date>=cdate('" & Left(CStr(dteDate), Len(CStr(dteDate)) - 2) & _
        "01" & "') and ps_date<cdate('" & CStr(dteDate) & "')) or order_id in (select " & _
        "other_id from other_head_b where other_date>=cdate('" & _
        Left(CStr(dteDate), Len(CStr(dteDate)) - 2) & "01" & "') and " & _
        "other_date<cdate('" & CStr(dteDate) & "'))) group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as sqty" & _
        ",sum(price) as sprice from sale_detail_b where p_id in " & _
        "(select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and sale_id in (select sale_id from " & _
        "sale_head_b where sale_date>=cdate('" & Left(CStr(dteDate), Len(CStr(dteDate)) - 2) & _
        "01" & "') and sale_date<cdate('" & CStr(dteDate) & "')) group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into rpt_mat select p_id,sum(begqty) as" & _
        " matbegqty,sum(begprice) as matbegprice,sum(oqty) as orderqty," & _
        "sum(oprice) as orderprice,sum(sqty) as saleqty,sum(sprice) as " & _
        "saleprice from temp_mat group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "update rpt_mat set matbegqty=0 where isnull(matbegqty)=true"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "update rpt_mat set matbegprice=0 where isnull(matbegprice)=true"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "update rpt_mat set orderqty=0 where isnull(orderqty)=true"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "update rpt_mat set orderprice=0 where isnull(orderprice)=true"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "update rpt_mat set saleqty=0 where isnull(saleqty)=true"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "update rpt_mat set saleprice=0 where isnull(saleprice)=true"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "update rpt_mat set matendqty=matbegqty+orderqty-saleqty," & _
        "matendprice=matbegprice+orderprice-saleprice"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "delete from temp_mat"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,matendqty as begqty," & _
        "matendprice as begprice from rpt_mat"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "delete from rpt_mat"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as oqty" & _
        ",sum(price) as oprice from order_detail_b where p_id in " & _
        "(select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and (order_id in (select ps_id from " & _
        "ps_head_b where ps_date=cdate('" & dteDate & "')) or order_id in (select " & _
        "other_id from other_head_b where other_date=cdate('" & dteDate & "'))) group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as sqty " & _
        "from sale_detail_b where p_id in (select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and sale_id in (select sale_id from " & _
        "sale_head_b where sale_date=cdate('" & dteDate & "')) group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strRptDte = CStr(Format(dteDate, "yyyy年mm月dd日"))
        strRptCap = strRptDte & strRptTyp & "日报"
    ElseIf OptRptType(1).Value = True Then
        strSQL = "insert into temp_mat select p_id,qty" & Right(strY, 2) & strM & _
        " as begqty,price" & Right(strY, 2) & strM & " as begprice from mat_head" _
        & " where p_id in (select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "')"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as oqty" & _
        ",sum(price) as oprice from order_detail_b where p_id in " & _
        "(select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and (order_id in (select ps_id from " & _
        "ps_head_b where year(ps_date)=" & CInt(strY) & _
        " and month(ps_date)=" & CInt(strM) & ") or order_id in (select " & _
        "other_id from other_head_b where year(other_date)=" & CInt(strY) _
        & " and month(other_date)=" & CInt(strM) & ")) group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as sqty " & _
        "from sale_detail_b where p_id in (select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and sale_id in (select sale_id from " & _
        "sale_head_b where year(sale_date)=" & CInt(strY) & _
        " and month(sale_date)=" & CInt(strM) & ") group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strRptDte = CStr(Format(dteDate, "yyyy年mm月"))
        strRptCap = strRptDte & strRptTyp & "月报"
    ElseIf OptRptType(2).Value = True Then
        strSQL = "insert into temp_mat select p_id,qty" & Right(strY, 2) & strM & _
        " as begqty,price" & Right(strY, 2) & strM & " as begprice from mat_head" _
        & " where p_id in (select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "')"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as oqty" & _
        ",sum(price) as oprice from order_detail_b where p_id in " & _
        "(select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and (order_id in (select ps_id from " & _
        "ps_head_b where year(ps_date)=" & CInt(strY) & ") or order_id in (select " & _
        "other_id from other_head_b where year(other_date)=" & CInt(strY) _
        & ")) group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strSQL = "insert into temp_mat select p_id,sum(qty) as sqty " & _
        "from sale_detail_b where p_id in (select p_id from product where type_id ='" & _
        Me.DLtProType.BoundText & "') and sale_id in (select sale_id from " & _
        "sale_head_b where year(sale_date)=" & CInt(strY) & ") group by p_id"
        cmRpt.CommandText = strSQL
        cmRpt.Execute
        strRptDte = CStr(Format(dteDate, "yyyy年"))
        strRptCap = strRptDte & strRptTyp & "年报"
    End If
    strSQL = "insert into rpt_mat select p_id,sum(begqty) as" & _
    " matbegqty,sum(begprice) as matbegprice,sum(oqty) as orderqty," & _
    "sum(oprice) as orderprice,sum(sqty) as saleqty from temp_mat" & _
    " group by p_id"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "delete from temp_mat"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "insert into temp_mat select a.p_id,b.product_name," & _
    "b.product_model,b.unit,a.matbegqty as begqty,a.matbegprice as " & _
    "begprice,a.orderqty as oqty,a.orderprice as oprice,a.saleqty as " & _
    "sqty from rpt_mat a,product b where a.p_id=b.p_id"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "delete from rpt_mat"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "insert into rpt_mat select p_id,product_name," & _
    "product_model,unit,begqty as matbegqty,begprice as " & _
    "matbegprice,oqty as orderqty,oprice as orderprice,sqty as " & _
    "saleqty from temp_mat"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "update rpt_mat set matbegqty=0 where isnull(matbegqty)=true"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "update rpt_mat set matbegprice=0 where isnull(matbegprice)=true"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "update rpt_mat set orderqty=0 where isnull(orderqty)=true"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "update rpt_mat set orderprice=0 where isnull(orderprice)=true"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "update rpt_mat set saleqty=0 where isnull(saleqty)=true"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
'此处单价使用ROUND()函数
    strSQL = "update rpt_mat set unit_price=round((matbegprice+orderprice)/" & _
    "(matbegqty+orderqty),2) where matbegqty+orderqty<>0"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "update rpt_mat set saleprice=unit_price*saleqty"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "update rpt_mat set matendqty=matbegqty+orderqty-saleqty," & _
    "matendprice=matbegprice+orderprice-saleprice"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
    strSQL = "drop table temp_mat"
    cmRpt.CommandText = strSQL
    cmRpt.Execute
End Sub