⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmrpttotuse.frm

📁 里面的内容包括:基盘存管理本信息管理库存管理入库管理出库管理等功能
💻 FRM
📖 第 1 页 / 共 2 页
字号:
Private Sub Form_Unload(Cancel As Integer)
    intNumWindows = Closewindow(intNumWindows)
    rsDepartment.Close
    Set cmTotUse = Nothing
    Set rsRpt = Nothing
    Set rsDepartment = Nothing
    Set rsExpTotUse = 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 TotUse_Rpt()
    Dim strSQL As String
    Dim dteDate As Date
    Dim strY, strM, strD As String
    strSQL = "create table temp_totuse(物品类别编号 text(2),物品类别名称 text(20))"
    cmTotUse.CommandText = strSQL
    cmTotUse.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_totuse add column " & !department_name _
                & " currency"
                cmTotUse.CommandText = strSQL
                cmTotUse.Execute
                strSQL = "insert into temp_totuse select left(p_id,2) as " & _
                "物品类别编号,price as " & !department_name & " from " & _
                "sale_detail_b where sale_id in (select sale_id from " & _
                "sale_head_b where sale_rid='" & !department_id _
                & "' and sale_date=cdate('" & dteDate & "'))"
                cmTotUse.CommandText = strSQL
                cmTotUse.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_totuse add column " & !department_name _
                & " currency"
                cmTotUse.CommandText = strSQL
                cmTotUse.Execute
                strSQL = "insert into temp_totuse select left(p_id,2) as " & _
                "物品类别编号,price as " & !department_name & " from " & _
                "sale_detail_b where 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) & ")"
                cmTotUse.CommandText = strSQL
                cmTotUse.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_totuse add column " & !department_name _
                & " currency"
                cmTotUse.CommandText = strSQL
                cmTotUse.Execute
                strSQL = "insert into temp_totuse select left(p_id,2) as " & _
                "物品类别编号,price as " & !department_name & " from " & _
                "sale_detail_b where sale_id in (select sale_id from " & _
                "sale_head_b where sale_rid='" & !department_id _
                & "' and year(sale_date)=" & CInt(strY) & ")"
                cmTotUse.CommandText = strSQL
                cmTotUse.Execute
                .MoveNext
            Wend
        End With
        strRptDte = CStr(Format(dteDate, "yyyy年"))
        strRptCap = strRptDte & strRptTyp & "年报"
    End If
    strSQL = "select 物品类别编号"
    With rsDepartment
        .MoveFirst
        While Not .EOF
            strSQL = strSQL & ",sum(" & !department_name & ") as " & _
            !department_name & "c"
            .MoveNext
        Wend
    End With
    strSQL = strSQL & " into temp_totuse2 from temp_totuse group by 物品类别编号"
    cmTotUse.CommandText = strSQL
    cmTotUse.Execute
    strSQL = "delete from temp_totuse"
    cmTotUse.CommandText = strSQL
    cmTotUse.Execute
    strSQL = "insert into temp_totuse select a.物品类别编号,b.type_name as 物品类别名称"
    With rsDepartment
        .MoveFirst
        While Not .EOF
            strSQL = strSQL & ",a." & !department_name & "c as " & _
            !department_name
            .MoveNext
        Wend
    End With
    strSQL = strSQL & " from temp_totuse2 a,product_type b where " & _
    "a.物品类别编号=b.type_id"
    cmTotUse.CommandText = strSQL
    cmTotUse.Execute
    strSQL = "drop table temp_totuse2"
    cmTotUse.CommandText = strSQL
    cmTotUse.Execute
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -