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

📄

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
        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                        '临时使用查询字符串

    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 "001"                   '物料编码
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    Sqlstr = "SELECT MNumber,MName,Model,PrimaryUnit,PrimaryUnitName,Ispcgl,Isbzqgl From Gy_Material Where stopflag=0 and MNumber='" & Trim(Str_JudgeText) & "' Or MName='" & Trim(Str_JudgeText) & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此物料编码不存在!"
                        GoTo Lrcwcl
                    Else
                        '2.放置字段事后处理程序
                        .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = ""
                        .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                        
                        .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "")      '显示物料编码
                        .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")      '显示物料名称
                        .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")     '显示物料规格型号
                        .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("PrimaryUnitName") & "")                         '单重
                        .TextMatrix(Dqpdwgh, 2) = RecTemp.Fields("Ispcgl")
                        .TextMatrix(Dqpdwgh, 3) = RecTemp.Fields("Isbzqgl")
                        
                        '根据公式计算结果
                        Call Sub_JoinCount(Dqpdwgh, Sydz("007", GridStr(), Szzls))
                        Call Sub_JoinCount(Dqpdwgh, Sydz("008", GridStr(), Szzls))
                        
                        
                        If Val(conBatch) = 1 Then
                          If RecTemp.Fields("ispcgl") Then
                            .ColHidden(Sydz("006", GridStr(), Szzls)) = False
                          Else
                             .ColHidden(Sydz("006", GridStr(), Szzls)) = True
                             For jsq = .FixedRows To .Rows - 1
                                If .TextMatrix(jsq, 0) = "*" Then
                                    If CBool(.TextMatrix(jsq, 2)) Then
                                        .ColHidden(Sydz("006", GridStr(), Szzls)) = False
                                    End If
                                End If
                             Next jsq
                            End If
                        End If
                        
                        If Val(conQuan) = 1 Then
                              If RecTemp.Fields("isbzqgl") Then
                               .ColHidden(Sydz("010", GridStr(), Szzls)) = False
                              Else
                               .ColHidden(Sydz("010", GridStr(), Szzls)) = True
                                For jsq = .FixedRows To .Rows - 1
                                    If .TextMatrix(jsq, 0) = "*" Then
                                        If CBool(.TextMatrix(jsq, 3)) Then
                                            .ColHidden(Sydz("010", GridStr(), Szzls)) = False
                                        End If
                                    End If
                                Next jsq
                              End If
                            End If
                        End If
                  Call Cshhjwg
                Else
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""                                             '物料名称
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""                                             '物料规格型号
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""
                End If
               
            Case "005"          '
                '1.放置字段有效性判断
                '2.放置字段事后处理程序
                If Not Trim(Str_JudgeText) = "" Then
                  Sqlstr = "SELECT MArea,MAreaName From KF_Marea Where (MArea='" & Trim(Str_JudgeText) & "' Or MAreaName='" & Trim(Str_JudgeText) & "') and whcode='" & Trim(LrText(1).Tag) & "' and endflag=1"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                        If RecTemp.EOF Then
                            Tsxx = "此货区不存在或不属于本仓库或不是末级货区!"
                            GoTo Lrcwcl
                        End If
                        .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("MAreaName") & "")
                        .TextMatrix(Dqpdwgh, 1) = Trim(RecTemp.Fields("MArea") & "")

                End If
            Case "006"
                If Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) <> "" Then
                    If Val(conBatch) = 1 Then
                         If Not CBool(.TextMatrix(Dqpdwgh, 2)) Then
                           .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = ""
                         End If
                    Else
                        .ColHidden(Sydz("006", GridStr(), Szzls)) = True
                    End If
                 Else
                    Tsxx = "请先输入物料编码!"
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                    
                 End If
            Case "007"          '数量
                '1.放置字段有效性判断
                '2.放置字段事后处理程序
                Call Sub_JoinCount(Dqpdwgh, Sydz("007", GridStr(), Szzls))   '数量(根据公式计算结果)
                
            Case "008"          '金额
                '1.放置字段有效性判断
                
                '2.放置字段事后处理程序
                Call Sub_JoinCount(Dqpdwgh, Sydz("008", GridStr(), Szzls))   '金额(根据公式计算结果)
             
            Case "009"          '金额
                '1.放置字段有效性判断
                
                '2.放置字段事后处理程序
                Call Sub_JoinCount(Dqpdwgh, Sydz("009", GridStr(), Szzls))   '金额(根据公式计算结果)
            Case "010"
                If Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) <> "" Then
                        If Val(conQuan) = 1 Then
                             If Not CBool(.TextMatrix(Dqpdwgh, 3)) Then
                               .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                             End If
                        Else
                            .ColHidden(Sydz("010", GridStr(), Szzls)) = True
                        End If
                    If Trim(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))) <> "" Then
                        If Not IsDate(Str_JudgeText) Then
                            Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
                            GoTo Lrcwcl
                        Else
                            If CDate(Str_JudgeText) < Xtrq Then
                                Tsxx = "失效日期不能小于系统登录日期!"
                                GoTo Lrcwcl
                            End If
                        End If
                    
                    End If
                Else
                    Tsxx = "请先输入物料编码!"
                    Call Xtxxts(Tsxx, 0, 1)
                    .TextMatrix(Dqpdwgh, Sydz("010", 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)         '判断网格列对应逻辑编号
               
            '[>>以下为自定义部分
            
            Case "008"    '单价改变
                '计算公式:单价*数量=金额
                If Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) <> 0 Then
                    .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))), "##0." + String(Xtjexsws, "0"))
                Else
                    .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = ""
                End If
            Case "007"    '数量改变
                '计算公式:单价*数量=金额
                If Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) <> 0 Then
                    .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
                Else
                    .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = ""
                End If
            Case "009"    '金额改变
                '计算公式:金额/数量=单价
                If Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) <> 0 Then
                    If Val(.TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) <> 0 Then
                        .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))), "###0." + String(Xtdjxsws, "0"))
                    End If
                End If
            '<<以上为自定义部分]
        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 - 1) 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 Not .ColHidden(jsqte) Then
            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
          End If

⌨️ 快捷键说明

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