包装物管理系统_帐簿统计_包装物台帐查询结果.frm

新世纪ERP包装物管理源代码

            Next Jsqte
        End With
    Else
        '1-"刷新"查询
        If Str_QueryCondi = "" Then
            Str_QueryCondi = " where 1=2 "
        End If
    End If

    Sqlstr = "SELECT DISTINCT WrappageCode FROM Cask_V_HarvestIssue " & Str_QueryCondi & " Order By WrappageCode"
    Set RecStr_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecStr_Query.EOF Then
        Call ShowValue
    Else
        If Trim(Cask_EstradeQuery.LrText(0).Text) <> "" Then
            Sqlstr = "SELECT Cask_Wrappage.*,Cask_Sort.SortName,Gy_UnitSet.UnitName  " & _
                    "FROM Cask_Wrappage LEFT OUTER JOIN Cask_Sort ON Cask_Wrappage.SortCode =" & _
                    "Cask_Sort.SortCode LEFT OUTER JOIN Gy_UnitSet ON Cask_Wrappage.UnitCode =" & _
                    "Gy_UnitSet.UnitCode where WrappageCode = '" & Trim(Cask_EstradeQuery.LrText(0).Tag) & "'"
            Set RecStr_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            Label2.Caption = Trim(RecStr_Query!WrappageCode & "")      '包装物编码
            Label4.Caption = Trim(RecStr_Query!WrappageName & "")      '包装物名称
            Label6.Caption = Trim(RecStr_Query!UnitName & "")          '计量单位
        Else
            Label2.Caption = ""      '包装物编码
            Label4.Caption = ""      '包装物名称
            Label6.Caption = ""      '计量单位
        End If
        CxbbGrid.Rows = CxbbGrid.FixedRows
    End If
End Sub
Private Sub ShowValue()
    Dim SqlStrTemp1 As String
    Dim SqlStrTemp2 As String
    Dim TempS As String
    Dim TempRecordset As ADODB.Recordset
    Dim SumQuan(5) As Double
    Dim GridID(3) As Long
    
    Sqlstr = "SELECT Cask_Wrappage.WrappageCode,Cask_Wrappage.WrappageName,Gy_UnitSet.UnitName FROM Cask_Wrappage LEFT OUTER JOIN " & _
            "Gy_UnitSet ON Cask_Wrappage.UnitCode = Gy_UnitSet.UnitCode where  WrappageCode='" & Trim(RecStr_Query!WrappageCode) & "' Order By WrappageCode"
    Set TempRecordset = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

    Label2.Caption = Trim(TempRecordset!WrappageCode & "")      '包装物编码
    Label4.Caption = Trim(TempRecordset!WrappageName & "")      '包装物名称
    Label6.Caption = Trim(TempRecordset!UnitName & "")          '计量单位
    
    If QueryStr <> "" Then
        SqlStrTemp1 = Temp1 + " and " + QueryStr + " and WrappageCode='" & Trim(RecStr_Query!WrappageCode) & "'"
        SqlStrTemp2 = "HIDate between " & Temp1 & " And " & Temp2 & " and " + QueryStr + " and WrappageCode='" & Trim(RecStr_Query!WrappageCode) & "'"
        TempS = QueryStr + " and WrappageCode='" & Trim(RecStr_Query!WrappageCode) & "'"
    Else
        SqlStrTemp1 = Temp1 + " and WrappageCode='" & Trim(RecStr_Query!WrappageCode) & "'"
        TempS = "WrappageCode='" & Trim(RecStr_Query!WrappageCode) & "'"
        SqlStrTemp2 = "HIDate between " & Temp1 & " And " & Temp2 & " and WrappageCode='" & Trim(RecStr_Query!WrappageCode) & "'"
    End If
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute("Cask_SP_Estrade """ & TempS & """,""< " + SqlStrTemp1 + """,""" + SqlStrTemp2 + """")
    
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        Jsqte = CxbbGrid.FixedRows
        Do While Not .EOF
            CxbbGrid.AddItem ""
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(Jsqte, 1) = IIf(!BillCode & "" = "", -1, !BillCode)                                               '单据ID
            CxbbGrid.TextMatrix(Jsqte, 2) = IIf(!BillType & "" = "", -1, !BillType)                                               '单据类型
            If Trim(!HIDate & "") <> "" Then CxbbGrid.TextMatrix(Jsqte, 0) = Mid(Format(Trim(!HIDate & ""), "yyyy-mm-dd"), 1, 7)
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Format(Trim(!HIDate & ""), "yyyy-mm-dd")                  '日期
            CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(!BillNum & "")                                       '单据号
            CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(!WhName & "")                                        '仓库
            CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(!ZYName & "")                                        '摘要
            CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = IIf(Val(!AmountIn) = 0, "", !AmountIn)                    '入库数量
            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = IIf(Val(!AmountOut) = 0, "", !AmountOut)                  '出库数量
            If Jsqte = CxbbGrid.FixedRows Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = IIf(Val(!StartQuan) = 0, "", !StartQuan)              '结存数量
            Else
                CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = IIf(Val(!AmountIn) + Val(CxbbGrid.ValueMatrix(Jsqte - 1, Sydz("007", GridStr(), Szzls))) - Val(!AmountOut) = 0, "", Val(!AmountIn) + Val(CxbbGrid.ValueMatrix(Jsqte - 1, Sydz("007", GridStr(), Szzls))) - Val(!AmountOut)) '结存数量
            End If
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
     
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
        
        CxbbGrid.Subtotal flexSTSum, 0, Sydz("005", GridStr(), Szzls), , , , , "1"
        CxbbGrid.Subtotal flexSTSum, 0, Sydz("006", GridStr(), Szzls), , , , , "1"
        CxbbGrid.Subtotal flexSTSum, 0, Sydz("007", GridStr(), Szzls), , , , , "1"
        GridID(0) = Sydz("005", GridStr(), Szzls)
        GridID(1) = Sydz("006", GridStr(), Szzls)
        GridID(2) = Sydz("007", GridStr(), Szzls)
        
        For i = CxbbGrid.FixedRows + 1 To CxbbGrid.Rows - 1
            If Trim(CxbbGrid.TextMatrix(i, 0)) = "1" Then GridID(3) = GridID(3) + 1
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(i) = Sjhgd
        Next i
            SumQuan(0) = Val(CxbbGrid.ValueMatrix(CxbbGrid.FixedRows, GridID(2)))
        For i = CxbbGrid.FixedRows + 1 To CxbbGrid.Rows - 1 + GridID(3)
            If Trim(CxbbGrid.TextMatrix(i, 0)) = "1" Then
                CxbbGrid.TextMatrix(i, Sydz("004", GridStr(), Szzls)) = "本月合计"
                If Val(CxbbGrid.TextMatrix(i, GridID(0))) = 0 Then CxbbGrid.TextMatrix(i, GridID(0)) = ""        '入库数量
                If Val(CxbbGrid.TextMatrix(i, GridID(1))) = 0 Then CxbbGrid.TextMatrix(i, GridID(1)) = ""        '出库数量
                SumQuan(1) = Val(CxbbGrid.ValueMatrix(i, GridID(0)))
                SumQuan(2) = Val(CxbbGrid.ValueMatrix(i, GridID(1)))
                If i = CxbbGrid.FixedRows + 1 Then
                    CxbbGrid.TextMatrix(i, GridID(2)) = IIf(SumQuan(0) + SumQuan(1) - SumQuan(2) = 0, "", SumQuan(0) + SumQuan(1) - SumQuan(2))  '结存数量
                Else
                    CxbbGrid.TextMatrix(i, GridID(2)) = IIf(Val(CxbbGrid.ValueMatrix(i - 1, GridID(2))) + SumQuan(1) - SumQuan(2) = 0, "", Val(CxbbGrid.ValueMatrix(i - 1, GridID(2))) + SumQuan(1) - SumQuan(2)) '结存数量
                End If
                
                SumQuan(3) = SumQuan(3) + Val(CxbbGrid.ValueMatrix(i, GridID(0)))
                SumQuan(4) = SumQuan(4) + Val(CxbbGrid.ValueMatrix(i, GridID(1)))
                CxbbGrid.TextMatrix(i, GridID(2)) = Val(CxbbGrid.ValueMatrix(i - 1, GridID(2)))
                SumQuan(5) = Val(CxbbGrid.ValueMatrix(i - 1, GridID(2)))
                i = i + 1
                If i = CxbbGrid.Rows - 1 Then
                    CxbbGrid.Rows = CxbbGrid.Rows + 1
                Else
                    CxbbGrid.AddItem "", i
                End If
                '设置数据行高度(Fixed)
                CxbbGrid.RowHeight(i) = Sjhgd

                CxbbGrid.TextMatrix(i, 0) = "-2"
                CxbbGrid.TextMatrix(i, Sydz("004", GridStr(), Szzls)) = "本年累计"
                CxbbGrid.TextMatrix(i, GridID(0)) = IIf(Val(SumQuan(3)) = 0, "", SumQuan(3))         '入库数量
                CxbbGrid.TextMatrix(i, GridID(1)) = IIf(Val(SumQuan(4)) = 0, "", SumQuan(4))         '出库数量
                CxbbGrid.TextMatrix(i, GridID(2)) = IIf(Val(SumQuan(5)) = 0, "", SumQuan(5))         '结存数量
            End If
        Next i
    End With

    ']以上为用户自定义部分

End Sub

'选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"BillNum"即可)
Private Sub Sub_First()             '首 张
    
    With RecStr_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveFirst
        Call ShowValue
    End With

End Sub

Private Sub Sub_Prev()             '上 张
    
    With RecStr_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MovePrevious
        If Not .BOF Then
        Else
            .MoveNext
        End If
        Call ShowValue
    End With

End Sub

Private Sub Sub_Next()             '下 张
    With RecStr_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveNext
        If Not .EOF Then
        Else
            .MovePrevious
        End If
        Call ShowValue
    End With

End Sub

Private Sub Sub_Last()              '末 张
    
    With RecStr_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveLast
        Call ShowValue
    End With

End Sub
    

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    
    Dim RecTemp As New ADODB.Recordset               '临时使用动态集
    Dim FromTemp As Long                '临时使用动态集

    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1)) = 0 Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1)) = -1 Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 1 Then
        Exit Sub
    End If

    Sqlstr = "SELECT BillCode From Cask_HarvestIssueMain Where BillCode=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1))
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Tsxx = "此单据已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            FromTemp = CxbbGrid.TextMatrix(CxbbGrid.Row, 2)
            
            '填充查询单据标识
            Cask_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 1)
            Xtcdcsfz = Str_QueryCondi
             '设置单据处理为列表查询(修改)状态
            Xtcdcs = "3"
           
            '调入单据处理窗体
             Select Case FromTemp
                Case 1
                    Cask_StartInput.Show 1
                Case 2, 4
                    Cask_Harvest.Show 1
                Case 3, 5
                    Cask_Issue.Show 1
            End Select
            If Xtfhcs = "1" Then
                Tsxx = "出库单发生变化,是否刷新出库单列表?"
                yhAnswer = Xtxxts(Tsxx, 2, 2)
                If yhAnswer = 1 Then
                    Xt_Wait.Show
                    Xt_Wait.Refresh
   
                    '加快显示速度
                    CxbbGrid.Redraw = False
 
                    '生成查询结果
                    Call Sub_Query(1)
   
                    CxbbGrid.Redraw = True
                    Xt_Wait.Hide
                End If
            End If
        End If
    End With

End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 2                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
      
    Bbxbt(2) = Space(5) + Trim(Label1.Caption) + Fun_FormatOutPut(Trim(Label2), 20)
    Bbxbt(2) = Bbxbt(2) + Trim(Label3.Caption) + Fun_FormatOutPut(Trim(Label4), 30)
    Bbxbt(2) = Bbxbt(2) + Trim(Label5.Caption) + Fun_FormatOutPut(Trim(Label6), 10)
    Bbxbt(1) = ""
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If

End Sub