+

VB开发的ERP系统

            
        Loop
        
    End With
    
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True

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

End Sub

Private Sub Timer2_Timer()

    Me.Timer2.Enabled = False
    Me.Visible = True
    Call Sub_Search
    
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
    
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
    
    '屏蔽网格失去焦点产生的有效性判断
    changelock = True
    
    Select Case Button.Key
    
    Case "yl"                                            '预 览
        If Fun_Drfrmyxxpd Then
            BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False, , False
        End If
    Case "dy"                                            '打 印
        If Fun_Drfrmyxxpd Then
            Dim yhAnswer As Integer      '打印提示
            
            '用户确认是否打印单据
            Tsxx = "请确认是否打印当前单据?"
            yhAnswer = Xtxxts(Tsxx, 2, 2)
            If yhAnswer = 2 Then
                Exit Sub
            End If
            BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True, , False
        End If
    Case "cx"                                            '查 询
        BadDebt_FrmReturnQuery.Show 1
        
        '根据查询条件调用查询函数
        If UCase(Trim(BadDebt_FrmReturnQuery.Tag)) = "TRUE" Then Call Sub_Query(0)
        
    Case "pz"                                            '凭 证(保 存)
        If Fun_Drfrmyxxpd Then
            Call Sub_SaveBill
        End If
    Case "qx"                                            '全 选
        Call Sub_WgSelect(0)
    Case "qq"                                            '全 消
        Call Sub_WgSelect(1)
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
    
    '解 锁
    Valilock = False
    changelock = False
    TextChangeLock = False
    
End Sub

Private Sub Sub_WgSelect(Xzzt As Integer)
    
    Dim jsqte As Integer
    Dim TmpJsq As Integer
    
    '非数据行退出
    If WglrGrid.Rows = WglrGrid.FixedRows Then
        Exit Sub
    End If
    
    jsqte = WglrGrid.Rows - WglrGrid.FixedRows
    
    With WglrGrid
        
        Select Case Xzzt
            Case 0  '当选择全选时选中所有记录
                For TmpJsq = .FixedRows To jsqte
                    .TextMatrix(TmpJsq, Sydz("001", GridStr(), Szzls)) = True
                Next TmpJsq
            Case 1  '当选择全选时放弃所有记录
                For TmpJsq = .FixedRows To jsqte
                    .TextMatrix(TmpJsq, Sydz("001", GridStr(), Szzls)) = False
                Next TmpJsq
            
        End Select
        
    End With
    
End Sub

Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态
    
    '录入文本框状态设置
    If TextEnabled Then
        For jsqte = Max_Text_Index To 0 Step -1
            '判断文本框是否可编辑
            If Textboolean(jsqte, 5) Then
                LrText(jsqte).Enabled = True
            Else
                LrText(jsqte).Enabled = False
            End If
        Next jsqte
    Else
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Enabled = False
        Next jsqte
    End If
    
End Sub

Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        If GridBoolean(.Col, 3) Then   '列表框录入
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
            
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
            
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With
    
End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
    
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
    
    Dim Str_JudgeText As String                 '临时有效性判断字段内容
    Dim Coljsq As Long                          '临时列计数器
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Sqlstr As String                        '临时使用查询字符串
    Dim Rate As Double
    Dim ForCode As String
    Dim Dbl_Bbje As Double
    Dim Bln_ConVertFlag As Boolean
    Dim Dbl_AccRate As Double
    
    With WglrGrid
        '非录入状态或非数据行则其有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分
            Case "008"                   '收回金额
            
            Rate = Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)))
            ForCode = Trim(.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)))
            Call Sub_GetAccRate(ForCode, Bln_ConVertFlag, Dbl_AccRate)    '取外币记帐汇率
                        
            If (Not Trim(Str_JudgeText) = "") And (Not Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) = "") Then
                '1.放置字段有效性判断
                If Val(Str_JudgeText) > Val(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) Then
                    Tsxx = "收回金额不能大于坏帐金额!"
                    GoTo Lrcwcl
                End If
            
                If Bln_ConVertFlag Then
                    If YbJe <> 0 And Rate <> 0 Then
                        Dbl_Bbje = Val(Format(Val(Str_JudgeText / Rate), "##." + String(Xtjexsws, "0")))
                    Else
                        Dbl_Bbje = 0
                    End If
                Else
                    Dbl_Bbje = Val(Format(Val(Str_JudgeText * Rate), "##." + String(Xtjexsws, "0")))
                End If
                .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = Dbl_Bbje
            Else
                '3.清空相关字段
                .TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)) = ""                                             '存货名称
                .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = ""                                             '存货规格型号
            End If
            '<<以上为自定义部分]
        End Select
        
        '字段录入正确后为零字段清空(Fixed)
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
        
        '字段录入正确后进行数据合计(Fixed)
        For Coljsq = Qslz To .Cols - 1
            Call Sjhj(Coljsq)
        Next Coljsq
        
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
    
Lrcwcl:    '录入错误处理
    With WglrGrid
        
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
        
        '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
        changelock = True
        .Select Dqpdwgh, Dqpdwgl
        changelock = False
        Call xswbk
        
        '函数返回False
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Sub Sub_JoinCount(Lng_CountRow As Long, Lng_CountCol As Long)       '当网格列值发生改变时,处理网格列之间的关联计算(可选)
    
    '过程参数:Lng_CountRow,Lng_CountCol 网格改变内容所处行列值
    
    With WglrGrid
        Select Case GridStr(Lng_CountCol, 1)         '判断网格列对应逻辑编号
            
            '[>>以下为自定义部分
            
            '<<以上为自定义部分]
        End Select
    End With
    
End Sub

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                     '录入数据行有效性判断,同时进行行处理
    
    '函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值
    
    Dim Lrywlz As Long                            '录入有误网格列值
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    
    With WglrGrid
        '判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
        If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        Else
            If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
                '当要判断行处于网格末行时才允许删行,否则要进行有效性判断
                If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
                    changelock = True
                    .RemoveItem Yxxpdh
                    If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                        .AddItem ""
                        .RowHeight(.Rows - 1) = Sjhgd
                    End If
                    changelock = False
                    Sjhzyxxpd = True
                    Exit Function
                End If
            End If
        End If
        
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
        
        '[>>以下为自定义部分
        
        '1.放置行有效性判断程序
        
        '1.1首先进行单个不能为空或不能为零判断(Fixed)
        For jsqte = Qslz To .Cols - 1
            
            '字段不能为空
            If GridInt(jsqte, 5) = 1 Then
                If Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
                    Tsxx = GridStr(jsqte, 2)
                    Lrywlz = jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
            
            '字段不能为零
            If GridInt(jsqte, 5) = 2 Then
                If Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
                    Tsxx = GridStr(jsqte, 2)
                    Lrywlz = jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
        Next jsqte