b

VB开发的ERP系统

    Xt_Wait.Hide

End Sub

Private Sub Sub_Query(Int_QueryType As Integer)                                     '生成查询结果(Define)
    
    '过程参数:Int_QueryType 0-"点确定按钮"查询  1-"刷新"查询

    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Long                           '临时动态计数器

    '以下为自定义部分[
 
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
        With FrmJljy_StoDemotionListQueryCg
         
            '生成查询条件
            Str_QueryCondi = " where 1=1 "
            
            For Jsqte = 0 To 9
                Select Case Jsqte
                    Case 0 '收料通知单号
                        If Trim(.LrText(0).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and purreciptnum = '" & Trim(.LrText(0).Text) & "'"
                        End If
                    Case 1 '物料编码
                        If Trim(.LrText(1).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and MNumber = '" & Trim(.LrText(1).Tag) & "'"
                        End If
                    Case 2  '物料大类
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and MSNumber = '" & Trim(.LrText(2).Tag) & "'"
                        End If
                    Case 3  '供应商
                        If Trim(.LrText(3).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and suppliercode = '" & Trim(.LrText(3).Tag) & "'"
                        End If
                    Case 4  '产地
                        If Trim(.LrText(4).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and areacode = '" & Trim(.LrText(4).Tag) & "'"
                        End If
                    Case 5  '进料日期(起始)
                        If Trim(.LrText(5).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And PurReciptDate>=' " & Trim(.LrText(5).Text) & "'"
                        End If
                    Case 6  '进料日期(终止)
                        If Trim(.LrText(6).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And PurReciptDate<= ' " & Trim(.LrText(6).Text) & "'"
                        End If
                    Case 7  '质量等级
                        If Trim(.LrText(7).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and GradeCode = '" & Trim(.LrText(7).Tag) & "'"
                        End If
                    Case 8  '单据号
                        If Trim(.LrText(8).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and stockchecknum = '" & Trim(.LrText(8).Text) & "'"
                        End If
                    Case 9   '审核状态
                        If Not .Opt_Check(0).Value Then
                            If .Opt_Check(1).Value Then
                                Str_QueryCondi = Str_QueryCondi & " and  Checker='' "
                            Else
                                Str_QueryCondi = Str_QueryCondi & " and  Checker<>'' "
                            End If
                        End If
                End Select
            Next Jsqte
        End With
    Else
        '1-"刷新"查询
        If Str_QueryCondi = "" Then
            Str_QueryCondi = " where 1=1 "
        End If
    End If
     
    Sqlstr = "select * from (SELECT purreciptnum,StockCheckMainID,StockCheckNum,StoDemotionID,MNumber,MName,Model,rtrim(CheckSortCode)+rtrim(gradecode) as gradecode,PurUnitName,PurReciptDate," & _
            "suppliername,Quantity,areaname,StoCheckDate,msnumber,suppliercode,areacode,Maker,MakeDate,Checker,GradeName FROM QC_V_StockDemotion where  PurReciptNum is not null) b " & _
             Str_QueryCondi & "and stodemotionId is not NULL  "

    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        Jsqte = CxbbGrid.FixedRows
        Do While Not .EOF
            CxbbGrid.AddItem ""
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(Jsqte, 0) = .Fields("StockCheckMainID")                                                             '降等使用报告单ID(主要用来查询定位用)
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("purreciptnum") & "")                          '收料通知单号
            CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MNumber") & "")                               '物料编码
            CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("MName") & "")                                 '物料名称
            CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                                 '规格型号
            CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("PurUnitName") & "")                           '计量单位
            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("suppliername") & "")                          '供应商名称
            CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Quantity") & "")                              '数量
            CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Format(Trim(.Fields("PurReciptDate") & ""), "yyyy-mm-dd")   '生产日期
            CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("areaname") & "")                              '物料产地
            CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Format(Trim(.Fields("StoCheckDate") & ""), "yyyy-mm-dd")    '检验日期
            CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("GradeName") & "")                             '质量等级
            CxbbGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("Maker") & "")                                 '制单人
            CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Format(Trim(.Fields("MakeDate") & ""), "yyyy-mm-dd")        '制单日期
            CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = Trim(.Fields("Checker") & "")                               '审核人
            CxbbGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("StockCheckNum") & "")                               '审核人
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
     
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With

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

End Sub

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

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

    Sqlstr = "SELECT StockCheckMainID From Qc_StoDemotion Where StockCheckMainID=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Tsxx = "此降等使用报告单已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            '填充查询单据标识
            XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
            Xtcdcsfz = Str_QueryCondi
                
            '设置单据处理为列表查询(修改)状态
            Xtcdcs = "2"
            '调入单据处理窗体
            FrmJljy_StoDemotionCg.HelpContextID = 150300301
            FrmJljy_StoDemotionCg.Show 1
            
            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 Sub_AddBill()                                              '新增单据

    '设置单据处理为填制单据状态
    Xtcdcs = "1"
    '调入单据处理窗体
    FrmJljy_StoDemotionCg.HelpContextID = 150300301
    FrmJljy_StoDemotionCg.Show 1
    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 Sub

Private Sub Sub_DeleteBill()                                            '删除降等使用报告单
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
  
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
  
    Tsxx = "请确认是否删除当前降等使用报告单?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
  
    If yhAnswer = 1 Then
        '1.判断当前降等使用报告单是否允许删除
        If Not Fun_AllowDelete Then
            Exit Sub
        End If
  
        '2.删除单据所有内容
        Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        On Error GoTo Swcwcl
        Cw_DataEnvi.DataConnect.BeginTrans
        '1.删除单据所有内容
        Cw_DataEnvi.DataConnect.Execute ("Delete Qc_StoDemotion Where StoCkCheckMainID=" & Val(Lng_BillID))    '删除子表内容
        Cw_DataEnvi.DataConnect.CommitTrans
      
        '删除网格进料单据数据
        Jsqte = CxbbGrid.FixedRows
        Do While Jsqte <= CxbbGrid.Rows - 1
            If Val(CxbbGrid.TextMatrix(Jsqte, 0)) = Lng_BillID Then
                CxbbGrid.RemoveItem (Jsqte)
            Else
                Jsqte = Jsqte + 1
            End If
        Loop
    Else
        Exit Sub
    End If
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除降等使用报告单过程出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
  
End Sub

Private Function Fun_AllowDelete() As Boolean                                        '判断当前单据是否允许删除
  
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '查询字符串
    Dim Lng_BillID As Long                 '单据ID
  
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select Checker From Qc_StoDemotion Where StockCheckMainID=" & Val(Lng_BillID)
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该降等使用报告单已审核,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            End If
    End With
    Fun_AllowDelete = True
  
End Function

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 = 1                                          '报 表 小 标 题 行 数
    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(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