📄 +
字号:
End With
'调整网格
Call Sub_AdjustGrid
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) '录入数据字段有效性判断,同时进行字段录入事后处理
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))
Select Case GridStr(Dqpdwgl, 1)
'以下为自定义部分[
'1.放置字段有效性判断程序
Case "001" '项目(如有效则调入项目编码)
If Len(Str_JudgeText) <> 0 Then
SqlStr = "Select * FROM Cwzz_Item Where ItemClassCode='" & Str_ItemClassCode & "' And (ItemCode='" & Str_JudgeText & "' OR ItemName='" & Str_JudgeText & "')"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With RecTemp
If .EOF Then
Tsxx = "此核算项目不存在!"
GoTo Lrcwcl
End If
'1.如果核算项目存在则存储相应核算项目编码
WglrGrid.TextMatrix(Dqpdwgh, 2) = Trim(RecTemp.Fields("ItemCode"))
WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("ItemName"))
End With
Else
WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""
End If
Case "003" '部门(如有效则调入部门编码)
If Len(Str_JudgeText) <> 0 Then
SqlStr = "Select DeptCode,DeptName,StopUse FROM Gy_Department Where DeptCode='" & Str_JudgeText & "' OR DeptName='" & Str_JudgeText & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With RecTemp
If .EOF Then
Tsxx = "此部门不存在!"
GoTo Lrcwcl
Else
If .Fields("StopUse") Then
Tsxx = "此部门已停用"
GoTo Lrcwcl
End If
End If
'1.如果部门存在则存储相应部门编码
WglrGrid.TextMatrix(Dqpdwgh, 3) = Trim(RecTemp.Fields("DeptCode"))
WglrGrid.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptName"))
End With
End If
Case "004" '往来个人(如有效则调入个人编码)
If Len(Str_JudgeText) <> 0 Then
SqlStr = "Select PerSonCode,PerSonName,DeptCode FROM Gy_PerSon Where PerSonCode='" & Str_JudgeText & "' OR PerSonName='" & Str_JudgeText & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With RecTemp
If .EOF Then
Tsxx = "此往来个人不存在!"
GoTo Lrcwcl
End If
'1.如果个人存在则存储相应个人编码,部门编码
WglrGrid.TextMatrix(Dqpdwgh, 3) = Trim(RecTemp.Fields("DeptCode"))
WglrGrid.TextMatrix(Dqpdwgh, 4) = Trim(RecTemp.Fields("PerSonCode"))
WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("PerSonName"))
End With
End If
Case "005" '往来客户(如有效则调入客户编码)
If Len(Str_JudgeText) <> 0 Then
SqlStr = "Select CusCode,CusName,StopUse FROM Gy_Customer Where CusCode='" & Str_JudgeText & "' OR CusName='" & Str_JudgeText & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With RecTemp
If .EOF Then
Tsxx = "此往来客户不存在!"
GoTo Lrcwcl
Else
If .Fields("StopUse") Then
Tsxx = "此客户已停用!"
GoTo Lrcwcl
End If
End If
'1.如果客户存在则存储相应客户编码
WglrGrid.TextMatrix(Dqpdwgh, 5) = Trim(RecTemp.Fields("CusCode"))
WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("CusName"))
End With
End If
Case "006" '往来供应商(如有效则调入供应商编码)
If Len(Str_JudgeText) <> 0 Then
SqlStr = "Select Supplier_Code,Supplier_Name,StopUse FROM Gy_Supplier Where Supplier_Code='" & Str_JudgeText & "' OR Supplier_Name='" & Str_JudgeText & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With RecTemp
If .EOF Then
Tsxx = "此往来供应商不存在!"
GoTo Lrcwcl
Else
If .Fields("StopUse") Then
Tsxx = "此供应商已停用!"
GoTo Lrcwcl
End If
End If
'1.如果供应商存在则存储相应供应商编码
WglrGrid.TextMatrix(Dqpdwgh, 6) = Trim(RecTemp.Fields("Supplier_Code"))
WglrGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Trim(RecTemp.Fields("Supplier_Name"))
End With
End If
Case "007", "008", "009", "010" '年初方向,年初余额,累计借方,累计贷方(本币)
If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
Else
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
End If
If Dbl_Qcye = 0 Then
.TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls)) = ""
Else
.TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls)) = Dbl_Qcye
End If
Case "007", "012", "013", "014" '年初方向,年初余额,累计借方,累计贷方(数量)
If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("012", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("014", GridStr(), Szzls)))
Else
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("012", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("014", GridStr(), Szzls)))
End If
If Dbl_Qcye = 0 Then
.TextMatrix(Dqpdwgh, Sydz("015", GridStr(), Szzls)) = ""
Else
.TextMatrix(Dqpdwgh, Sydz("015", GridStr(), Szzls)) = Dbl_Qcye
End If
Case "007", "016", "017", "018" '年初方向,年初余额,累计借方,累计贷方(原币)
If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("016", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("017", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("018", GridStr(), Szzls)))
Else
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("016", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("017", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("018", GridStr(), Szzls)))
End If
If Dbl_Qcye = 0 Then
.TextMatrix(Dqpdwgh, Sydz("019", GridStr(), Szzls)) = ""
Else
.TextMatrix(Dqpdwgh, Sydz("019", GridStr(), Szzls)) = Dbl_Qcye
End If
Case "007", "020", "021", "022" '年初方向,年初余额,累计借方,累计贷方(项目数量)
If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("020", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("021", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("022", GridStr(), Szzls)))
Else
Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("020", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("021", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("022", GridStr(), Szzls)))
End If
If Dbl_Qcye = 0 Then
.TextMatrix(Dqpdwgh, Sydz("023", GridStr(), Szzls)) = ""
Else
.TextMatrix(Dqpdwgh, Sydz("023", GridStr(), Szzls)) = Dbl_Qcye
End If
'2.放置字段事后处理程序
'以上为自定义部分]
End Select
'字段录入正确后为零字段清空
Call Qkwlzd(Dqpdwgh, Dqpdwgl)
sjzdyxxpd = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -