-

VB开发的ERP系统

            CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("deptname1") & "")         '转出部门
            CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("deptname2") & "")         '转入部门
            CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("mareaname1") & "")        '转出货区
            CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("mareaname2") & "")        '转入货区
            If Not IsNull(.Fields("InvalidDate")) Then
                CxbbGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Format(Trim(.Fields("InvalidDate") & ""), "yyyy-mm-dd") '失效日期
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = Trim(.Fields("maker") & "")             '制单人
            CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("checker") & "")           '审核人
            CxbbGrid.TextMatrix(jsqte, Sydz("016", GridStr(), Szzls)) = Trim(.Fields("ChalkitupMan") & "")      '记帐人
            
            If .Fields("quan") <> 0 Then
                CxbbGrid.TextMatrix(jsqte, Sydz("017", GridStr(), Szzls)) = .Fields("quan")                     '数量
            End If
            If .Fields("planprice") <> 0 Then
                CxbbGrid.TextMatrix(jsqte, Sydz("018", GridStr(), Szzls)) = .Fields("planprice")                '计划单价
            End If
            If .Fields("price") <> 0 Then
                CxbbGrid.TextMatrix(jsqte, Sydz("019", GridStr(), Szzls)) = .Fields("price")                    '实际单价
            End If
            If .Fields("PlanMoney") <> 0 Then
                CxbbGrid.TextMatrix(jsqte, Sydz("020", GridStr(), Szzls)) = .Fields("PlanMoney")                '计划金额
            End If
            If .Fields("EMoney") <> 0 Then
                CxbbGrid.TextMatrix(jsqte, Sydz("021", GridStr(), Szzls)) = .Fields("EMoney")                   '实际金额
            End If

            
            '<<]
            '设置数据行高度(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.Rows = CxbbGrid.FixedRows Then
        Exit Sub
    End If
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If

    Sqlstr = "SELECT MovemainID From kf_Movemain Where MoveMainId=" & 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"
            With KF_FrmDBD
                
                '填充查询单据标识
                .Show 1
            End With
            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()                                              '新增单据
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
     End If
    With KF_FrmDBD
   
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
         
        .Show 1
    End With
       
    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 Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
     End If
    '当第一次查询结果为空时,判断总记录行是否与固定行数相同,如相同则出现错误(双表头出现此情况)
    If CxbbGrid.Rows = CxbbGrid.FixedRows Then
        Exit Sub
    End If    '非数据行退出
    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
        
        '1.删除单据所有内容
        Dim Rec_Sub As New Recordset
        Set Rec_Sub = Cw_DataEnvi.DataConnect.Execute("select whcode,mnumber,marea,batchnum,FactReceiptQuan from KF_V_OtherIn where InOutMainId=" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1))))
        With Rec_Sub
            If Not .EOF Then
                .MoveFirst
                Cw_DataEnvi.DataConnect.Execute ("delete KF_Batch where fathertablenum='" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1))) & "'")
                For LsJs = 1 To .RecordCount
                    StrTemp1 = Trim(.Fields("marea") & "")
                    '1修改现存量
                    Cw_DataEnvi.DataConnect.Execute (" KF_SP_ChangeQuan '" & Trim(.Fields("whcode")) & "','" & StrTemp1 & "','" & Trim(.Fields("mnumber")) & "','" & Trim(.Fields("batchnum")) & "'," & Val(.Fields("FactReceiptQuan")) & ",1")
                    .MoveNext
                Next LsJs
            End If
        End With
        
        If Rec_Sub.State = 1 Then Rec_Sub.Close
        Set Rec_Sub = Cw_DataEnvi.DataConnect.Execute("select whcode,mnumber,marea,batchnum,FactIssueQuan from KF_V_OtherOut where InOutMainId=" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 2))))
        With Rec_Sub
            If Not .EOF Then
                .MoveFirst
                For LsJs = 1 To .RecordCount
                    StrTemp1 = Trim(.Fields("marea") & "")
                    '1修改现存量
                    Cw_DataEnvi.DataConnect.Execute (" KF_SP_ChangeQuan '" & Trim(.Fields("whcode")) & "','" & StrTemp1 & "','" & Trim(.Fields("mnumber")) & "','" & Trim(.Fields("batchnum")) & "'," & Val(.Fields("FactIssueQuan")) & ",0")
                    '4修改实际出库数量
                    If Trim(.Fields("batchnum") & "") <> "" Then
                        If BatchJudge(Trim(.Fields("whcode")), Trim(.Fields("mnumber")), Trim(.Fields("batchnum")), intCount, intFatherID(), intChildID(), IsQc(), True) = 0 Then
                            Call RestoreQuan(intCount, intFatherID(), intChildID(), IsQc(), .Fields("FactIssueQuan"), True)
                        End If
                    End If
                    .MoveNext
                Next LsJs
            End If
        End With
        
        Cw_DataEnvi.DataConnect.BeginTrans
        Cw_DataEnvi.DataConnect.Execute ("Delete gy_inoutsub Where inoutMainID=" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1))))
        Cw_DataEnvi.DataConnect.Execute ("Delete gy_inoutmain Where inoutMainID=" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1))))
        Cw_DataEnvi.DataConnect.Execute ("Delete gy_inoutsub Where inoutMainID=" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 2))))
        Cw_DataEnvi.DataConnect.Execute ("Delete gy_inoutmain Where inoutMainID=" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 2))))
        Cw_DataEnvi.DataConnect.Execute ("Delete Kf_MoveSub Where MovemainID=" & Val(Lng_BillID))
        Cw_DataEnvi.DataConnect.Execute ("Delete kf_Movemain Where MovemainID=" & 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
    Dim adoCheck As New ADODB.Recordset
    
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select checker,ChalkitupMan From kf_Movemain Where MovemainID=" & Val(Lng_BillID)
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    Set adoCheck = Cw_DataEnvi.DataConnect.Execute("select KfChecker from gy_inoutmain where kfchecker<>'' and inoutmainid in(" & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1))) & "," & Val(Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 2))) & ")")
    
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("checker") & "") <> "" Or Trim(.Fields("ChalkitupMan") & "") <> "" Then
                Tsxx = "该调拨单已审核或记帐,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            End If
    End With
    
    With adoCheck
        If Not .EOF Then
            Tsxx = "该单据的系统生成单据已审核或记帐,不能修改或删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        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