📄
字号:
If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = .Fields("PlanMoneyMin") '四月份销售定额
End If
Case 5
If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("PlanMoney") & "") '五月份计划额
End If
If Val(Trim(.Fields("PlanMoneyMin") & "")) <> 0 Then
WglrGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = .Fields("PlanMoneyMin") '五月份销售定额
End If
Case 6
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 7
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 8
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 9
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 10
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 11
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 12
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
End Select
'<<]
WglrGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Loop
End With
End If
Next
For Coljsq = Qslz To WglrGrid.Cols - 1
Call Sjhj(Coljsq)
Next Coljsq
'将网格刷新解禁(Fixed)
WglrGrid.Redraw = True
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 "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) '录入数据字段有效性判断,同时进行字段录入事后处理
Dim Str_JudgeText As String '临时有效性判断字段内容
Dim Coljsq As Long '临时列计数器
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim Dbl_Qcye As Double '临时期初余额
With WglrGrid
'非录入状态有效性为合法
If Yxxpdlock Or .Row < .FixedRows Then
sjzdyxxpd = True
Exit Function
End If
Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
If Val(Str_JudgeText) < 0 Then
Tsxx = "金额不能为负!"
GoTo Lrcwcl
End If
Select Case GridStr(Dqpdwgl, 1)
'以下为自定义部分[
'1.放置字段有效性判断程序
'Case "004"
'2.放置字段事后处理程序
'以上为自定义部分]
End Select
'字段录入正确后为零字段清空
Call Qkwlzd(Dqpdwgh, Dqpdwgl)
'字段录入正确后进行数据合计(Fixed)
For Coljsq = Qslz To .Cols - 1
Call Sjhj(Coljsq)
Next Coljsq
sjzdyxxpd = True
Yxxpdlock = True
Exit Function
End With
Lrcwcl: '录入错误处理
With WglrGrid
Call Xtxxts(Tsxx, 0, 1)
Changelock = True
.Select Dqpdwgh, Dqpdwgl
Changelock = False
Call xswbk
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 Str_Ccode As String '临时索引编码
Dim TempCol As Long
Dim MonthValue As Long
Dim SumPlanMoney As Single
Dim SumPlanMoneyMin As Single
With WglrGrid
If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
'行没有发生变化则不进行有效性判断
If Hyxxpdlock Then
Sjhzyxxpd = True
Exit Function
End If
'以下为自定义部分[
'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
'1.2进行其他有效性判断,编写格式同1.1
'判断年计划额是否等于各月计划额之和
'判断年计划定额是否等于各月计划定额之和
For TempCol = 5 To 27 Step 2
If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)) = "" Then
SumPlanMoney = SumPlanMoney + 0
Else
SumPlanMoney = SumPlanMoney + Val(Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)))
End If
If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) = "" Then
SumPlanMoneyMin = SumPlanMoneyMin + 0
Else
SumPlanMoneyMin = SumPlanMoneyMin + Val(Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)))
End If
Next
If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 3))) <> SumPlanMoney Then
Tsxx = "年计划额不等于各月计划额总和!"
Lrywlz = 3
GoTo Lrcwcl
End If
If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 4))) <> SumPlanMoneyMin Then
Tsxx = "年计划定额不等于各月计划定额总和!"
Lrywlz = 4
GoTo Lrcwcl
End If
'判断年计划额和年计划定额是否同时为零
If Val(WglrGrid.TextMatrix(Yxxpdh, 3)) = 0 And Val(WglrGrid.TextMatrix(Yxxpdh, 4)) = 0 Then
Sjhzyxxpd = True
Exit Function
End If
'2.放置行处理程序(当数据行通过有效性判断)
Str_Ccode = Trim(.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
If WglrGrid.TextMatrix(Yxxpdh, 29) <> "" Then
Cw_DataEnvi.DataConnect.Execute ("delete from xs_plan WHERE Planid>=" & Val(WglrGrid.TextMatrix(Yxxpdh, 29)) & " and Planid<=" & Val(WglrGrid.TextMatrix(Yxxpdh, 29)) + 12)
End If
With RecTemp
If .State = 1 Then .Close
.Open "SELECT * FROM Xs_Plan WHERE DeptCode='" & Str_Ccode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
MonthValue = 0
For TempCol = 3 To 27 Step 2
.AddNew
.Fields("DeptCode") = Str_Ccode
.Fields("KjYear") = Xtyear
.Fields("Period") = MonthValue
If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)) = "" Then
.Fields("PlanMoney") = 0
Else
.Fields("PlanMoney") = Val(WglrGrid.TextMatrix(Yxxpdh, TempCol)) '金额
End If
If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) = "" Then
.Fields("PlanMoneyMin") = 0
Else
.Fields("PlanMoneyMin") = Val(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) '金额 .Update
End If
MonthValue = MonthValue + 1
RecTemp.Update
Next
WglrGrid.TextMatrix(Yxxpdh, 29) = .Fields("PlanID") - 12
End With
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -