frmrptdetuse.frm

库存管理系统,有详细的代码,就是没论文.VB+ACCE

    Me.Height = 3705
    Me.Width = 5820
    Call SetFormStu(Me, frmMain)
    Set cmDetUse = New ADODB.Command
    cmDetUse.ActiveConnection = DEjxc.Conjxc
    cmDetUse.CommandType = adCmdText
    Set rsRpt = New ADODB.Recordset
    Set rsExpDetUse = New ADODB.Recordset
    Set rsDepartment = DEjxc.rsComDepartment
    rsDepartment.Open
    TxtYear.Text = Year(dteSysDate)
    TxtMonth.Text = Month(dteSysDate)
    TxtDay.Text = Day(dteSysDate)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    intNumWindows = Closewindow(intNumWindows)
    rsDepartment.Close
    Set cmDetUse = Nothing
    Set rsRpt = Nothing
    Set rsDepartment = Nothing
    Set rsExpDetUse = Nothing
End Sub

Private Sub OptRptType_Click(Index As Integer)
    Select Case Index
        Case 0
            Me.TxtDay.Enabled = True
            Me.TxtMonth.Enabled = True
        Case 1
            Me.TxtDay.Enabled = False
            Me.TxtMonth.Enabled = True
        Case 2
            Me.TxtDay.Enabled = False
            Me.TxtMonth.Enabled = False
    End Select
End Sub

Private Sub OptRptType_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then
        TxtYear.SelStart = 0
        TxtYear.SelLength = Len(TxtYear.Text)
        TxtYear.SetFocus
    End If
End Sub

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 DetUse_Rpt()
    Dim strSQL As String
    Dim dteDate As Date
    Dim strY, strM, strD As String
    strSQL = "create table temp_detuse(p_id text(8),product_name text(30)," & _
    "product_model text(18),unit text(4))"
    cmDetUse.CommandText = strSQL
    cmDetUse.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 & "-12")
    End If
    strY = CStr(Year(dteDate))
    strM = Format(CStr(Month(dteDate)), "0#")
    If OptRptType(0).Value = True Then
        With rsDepartment
            .MoveFirst
            While Not .EOF
                strSQL = "alter table temp_detuse add column " & !department_name _
                & " single"
                cmDetUse.CommandText = strSQL
                cmDetUse.Execute
                strSQL = "insert into temp_detuse select p_id,sum(qty) as " & _
                !department_name & " 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_rid='" & !department_id _
                & "' and sale_date=cdate('" & dteDate & "')) group by p_id"
                cmDetUse.CommandText = strSQL
                cmDetUse.Execute
                .MoveNext
            Wend
        End With
        strRptDte = CStr(Format(dteDate, "yyyy年mm月dd日"))
        strRptCap = strRptDte & strRptTyp & "日报"
    ElseIf OptRptType(1).Value = True Then
        With rsDepartment
            .MoveFirst
            While Not .EOF
                strSQL = "alter table temp_detuse add column " & !department_name _
                & " single"
                cmDetUse.CommandText = strSQL
                cmDetUse.Execute
                strSQL = "insert into temp_detuse select p_id,sum(qty) as " & _
                !department_name & " 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_rid='" & !department_id _
                & "' and year(sale_date)=" & CInt(strY) & _
                " and month(sale_date)=" & CInt(strM) & ") group by p_id"
                cmDetUse.CommandText = strSQL
                cmDetUse.Execute
                .MoveNext
            Wend
        End With
        strRptDte = CStr(Format(dteDate, "yyyy年mm月"))
        strRptCap = strRptDte & strRptTyp & "月报"
    ElseIf OptRptType(2).Value = True Then
        With rsDepartment
            .MoveFirst
            While Not .EOF
                strSQL = "alter table temp_detuse add column " & !department_name _
                & " single"
                cmDetUse.CommandText = strSQL
                cmDetUse.Execute
                strSQL = "insert into temp_detuse select p_id,sum(qty) as " & _
                !department_name & " 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_rid='" & !department_id _
                & "' and year(sale_date)=" & CInt(strY) & ") group by p_id"
                cmDetUse.CommandText = strSQL
                cmDetUse.Execute
                .MoveNext
            Wend
        End With
        strRptDte = CStr(Format(dteDate, "yyyy年"))
        strRptCap = strRptDte & strRptTyp & "年报"
    End If
    strSQL = "select p_id"
    With rsDepartment
        .MoveFirst
        While Not .EOF
            strSQL = strSQL & ",sum(" & !department_name & ") as " & _
            !department_name & "c"
            .MoveNext
        Wend
    End With
    strSQL = strSQL & " into temp_detuse2 from temp_detuse group by p_id"
    cmDetUse.CommandText = strSQL
    cmDetUse.Execute
    strSQL = "delete from temp_detuse"
    cmDetUse.CommandText = strSQL
    cmDetUse.Execute
    strSQL = "insert into temp_detuse select a.p_id,b.product_name," & _
    "b.product_model,b.unit"
    With rsDepartment
        .MoveFirst
        While Not .EOF
            strSQL = strSQL & ",a." & !department_name & "c as " & _
            !department_name
            .MoveNext
        Wend
    End With
    strSQL = strSQL & " from temp_detuse2 a,product b where a.p_id=b.p_id"
    cmDetUse.CommandText = strSQL
    cmDetUse.Execute
    strSQL = "drop table temp_detuse2"
    cmDetUse.CommandText = strSQL
    cmDetUse.Execute
End Sub