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

📄

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
                    Select Case .Fields("Period")
                        Case 0
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '年计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("PlanMoney")                                '年计划金额
                            End If
                        Case 1
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '一月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = .Fields("PlanMoney")                                '一月份计划金额
                            End If
                        Case 2
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '二月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = .Fields("PlanMoney")                                '二月份计划金额
                            End If
                        Case 3
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '三月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = .Fields("PlanMoney")                                '三月份计划金额
                            End If
                        Case 4
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '四月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = .Fields("PlanMoney")                                '四月份计划金额
                            End If
                        Case 5
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '五月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = .Fields("PlanMoney")                                '五月份计划金额
                            End If
                        Case 6
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '六月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = .Fields("PlanMoney")                                '六月份计划金额
                            End If
                        Case 7
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("021", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '七月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("022", GridStr(), Szzls)) = .Fields("PlanMoney")                                '七计划金额
                            End If
                        Case 8
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("023", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '八月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("024", GridStr(), Szzls)) = .Fields("PlanMoney")                                '八月份计划金额
                            End If
                        Case 9
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("025", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '九月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("026", GridStr(), Szzls)) = .Fields("PlanMoney")                                '九月份计划金额
                            End If
                        Case 10
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("027", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("028", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十月份计划金额
                            End If
                        Case 11
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("029", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十一月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("030", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十一月份计划金额
                            End If
                        Case 12
                            If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("031", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十二月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("032", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十二月份计划金额
                            End If
                    End Select
            '<<]
           
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
        Loop
    End With
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True

    '调整网格(Fixed)
    Call Sub_AdjustGrid
    '在辅助行上填写合计行
    WglrGrid.TextMatrix(WglrGrid.Rows - 1, 1) = "合计"
    '进行列合计
    For Coljsq = Qslz To WglrGrid.Cols - 1
        Call Sjhj(Coljsq)
    Next Coljsq
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
     
    '屏蔽文本框,下拉组合框有效性判断
     
    Valilock = True
     
    '屏蔽网格失去焦点产生的有效性判断
     
    Changelock = True
     
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            If Fun_Drfrmyxxpd Then
                Call bbyl(True)
            End If
        Case "dy"                                            '打 印
            If Fun_Drfrmyxxpd Then
                Call bbyl(False)
            End If
        Case "sh"                                            '删 行
            Call Scdqfl
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
                Unload Me
    End Select
       
    '解 锁
    Valilock = False
    Changelock = False
        
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作

    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                   'Ctrl+P 打印
                If Tlb_Action.Buttons("dy").Enabled Then
                    Call bbyl(False)
                End If
            End Select
    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                 '临时有效性判断字段内容(Fixed)
    Dim Coljsq As Long                          '临时列计数器(Fixed)
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
    Dim Sqlstr As String                        '临时使用查询字符串(Fixed)

    With WglrGrid
    
        '非录入状态或非数据行则其有效性为合法(Fixed)
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
      
        '取得当前要判断字段内容(Fixed)
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
      
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
         
            '[>>以下为自定义部分
         
            Case "001"                   '人员编码(字段不为空则做有效性判断及事后处理)
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    If GTempDeptCode = "" Then
                        Sqlstr = "SELECT Gy_Person.DeptCode,deptName,PersonCode,PersonName From Gy_Person,Gy_Department Where Gy_Department.XsFlag='1' and Gy_Person.DeptCode=Gy_Department.DeptCode and (PersonCode='" & Str_JudgeText & "' Or PersonName='" & Str_JudgeText & "')"
                    Else
                        Sqlstr = "SELECT Gy_Person.DeptCode,deptName,PersonCode,PersonName From Gy_Person,Gy_Department Where Gy_Department.Deptcode='" & GTempDeptCode & "' and Gy_Person.DeptCode=Gy_Department.DeptCode and (PersonCode='" & Str_JudgeText & "' Or PersonName='" & Str_JudgeText & "')"
                    End If
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                  
                    If RecTemp.EOF Then
                        Tsxx = "此人员编码不存在!"
                        GoTo Lrcwcl
                    End If
                    
                    '2.放置字段事后处理程序
                    .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("PersonCode") & "")      '显示人员编码
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("PersonName") & "")      '显示人员名称
                    .TextMatrix(Dqpdwgh, Sydz("033", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptCode") & "")      '显示部门编码
                    .TextMatrix(Dqpdwgh, Sydz("034", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptName") & "")      '显示部门编码
                Else
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("000", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, Sydz("033", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, Sydz("034", GridStr(), Szzls)) = ""
                End If
            Case "003"                   '存货编码(字段不为空则做有效性判断及事后处理)
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    If .TextMatrix(Dqpdwgh, Sydz("035", GridStr(), Szzls)) <> "" Then
                        Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Material Where Planid<> " & .TextMatrix(Dqpdwgh, Sydz("035", GridStr(), Szzls)) & " and Period=0 and KjYear=" & Xtyear & " and issale=1 and StopFlag=0 and Xs_Plan.Warecode=Gy_Material.Mnumber and PersonCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & "'  and (Warecode='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "')"
                    Else
                        Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Material Where Period=0 and KjYear=" & Xtyear & " and issale=1 and StopFlag=0 and Xs_Plan.Warecode=Gy_Material.Mnumber and PersonCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & "'  and (Warecode='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "')"
                    End If
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                  
                    If Not RecTemp.EOF Then
                        Tsxx = "此销售员已经有该货物的销售计划!"
                        GoTo Lrcwcl
                    End If
                End If
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    Sqlstr = "SELECT MNumber,MName,Model,SaleUnitName From Gy_material Where (MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "') And IsSale='1'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                  
                    If RecTemp.EOF Then
                        Tsxx = "此货物编码不存在!"
                        GoTo Lrcwcl
                    End If
                    
                    '2.放置字段事后处理程序
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "")      '显示存货编码
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")      '显示存货编码
                    .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")      '显示存货名称
                    .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Trim(RecTemp.Fields("SaleUnitName") & "")      '显示存货名称
                Else
                
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""                                             '显示存货名称
                    .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = ""                                             '显示存货名称
                    .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = ""                                             '显示存货名称
                End If
                
            '<<以上为自定义部分]
        End Select
     
        '字段录入正确后为零字段清空(Fixed)
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
        For Coljsq = Qslz To .Cols - 1
            Call Sjhj(Coljsq)
        Next Coljsq
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
  
Lrcwcl:    '录入错误处理(Fixed)

    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

⌨️ 快捷键说明

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