+-+

VB开发的ERP系统

                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '四月份计划金额
                            End If
                        Case 5
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '五月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '五月份计划金额
                            End If
                        Case 6
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '六月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '六月份计划金额
                            End If
                        Case 7
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '七月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '七计划金额
                            End If
                        Case 8
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("021", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '八月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("022", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '八月份计划金额
                            End If
                        Case 9
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("023", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '九月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("024", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '九月份计划金额
                            End If
                        Case 10
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("025", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '十月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("026", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '十月份计划金额
                            End If
                        Case 11
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("027", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '十一月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("028", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '十一月份计划金额
                            End If
                        Case 12
                            If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("029", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "")                    '十二月份计划数量
                            End If
                            If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
                                WglrGrid.TextMatrix(Jsqte, Sydz("030", GridStr(), Szzls)) = .Fields("PlanMoneyMin")                                '十二月份计划金额
                            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.放置字段有效性判断
                        Sqlstr = "SELECT * From Gy_Department Where Gy_Department.XsFlag='1' and (DeptCode='" & Str_JudgeText & "' Or DeptName='" & Str_JudgeText & "')"
                    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("DeptCode") & "")      '显示部门编码
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptName") & "")      '显示部门名称
                Else
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("000", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""
                End If
            Case "003"                   '存货编码(字段不为空则做有效性判断及事后处理)
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    If .TextMatrix(Dqpdwgh, Sydz("031", GridStr(), Szzls)) <> "" Then
                        Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Customer Where Planid<> " & .TextMatrix(Dqpdwgh, Sydz("031", GridStr(), Szzls)) & _
                                " and Period=0 and Xs_Plan.PersonCode='' and KjYear=" & Xtyear & " and StopFlag=0 and " & _
                                " Xs_Plan.Cuscode=Gy_Customer.Cuscode and Xs_Plan.DeptCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & _
                                "'  and (Gy_Customer.CusCode='" & Str_JudgeText & "' Or Gy_Customer.CusName='" & Str_JudgeText & "')"
                    Else
                        Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Customer Where Period=0 and Xs_Plan.PersonCode='' and KjYear=" & Xtyear & _
                                " and StopFlag=0 and Xs_Plan.Cuscode=Gy_Customer.Cuscode and Xs_Plan.DeptCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & _
                                "'  and (Gy_Customer.CusCode='" & Str_JudgeText & "' Or Gy_Customer.CusName='" & 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 CusCode,CusName From Gy_Customer Where CusCode='" & Str_JudgeText & "' Or CusName='" & Str_JudgeText & "'"
                    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("Cuscode") & "")      '显示存货编码
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("CusName") & "")      '显示存货编码
                Else
                
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("004", 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
    
End Function
Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
    
    Dim Hjjg As Double
    If Not GridBoolean(Hjwgl, 4) Then
        Exit Sub
    End If
    With WglrGrid
        Hjjg = 0
        For Jsqte = .FixedRows To .Rows - 2
                If Trim(.TextMatrix(Jsqte, Hjwgl)) <> "" Then
                    Hjjg = Hjjg + Val(.TextMatrix(Jsqte, Hjwgl))
                End If
        Next Jsqte
        If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
            WglrGrid.TextMatrix(.Rows - 1, Hjwgl) = ""
        Else
            WglrGrid.TextMatrix(.Rows - 1, Hjwgl) = Hjjg
        End If
    End With

End Sub

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串
    Dim SumPlanAmount As Single
    Dim SumPlanMoney As Single
    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