📄 +
字号:
& "Left Outer Join Cwzz_AccCode E On A.CCode=E.CCode " _
& "Order By Objectcode"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With Cxnrrec
CzxsGrid.Clear 1
CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
If .EOF And .BOF Then
Exit Sub
End If
jsqte = CzxsGrid.FixedRows
Do While Not .EOF
If jsqte >= CzxsGrid.Rows Then
CzxsGrid.AddItem ""
End If
Call Jltcwg(Cxnrrec, jsqte)
CzxsGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
End With
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long) '记录内容填充网格
'[以下为自定义部分
With Jlbrec
CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Objectcode") & "") '对象编码
CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ObjectName") & "") '对象名称
CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("ObjectTypeName") & "") '对象类别
CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("UnitName") & "") '计量单位
CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("PlanQuantity") & "") '计划数量
CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("PlanCost") & "") '计划成本
CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("CName") & "") '结转科目
CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("CalOrder") & "") '计算顺序
CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("CenterName") & "") '成本中心
End With
'以上为自定义部分]
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
Set Cxnrrec = Nothing
Unload Dyymctbl
End Sub
Private Function Bclrsj() As Boolean '判断录入数据有效性,并保存数据
Dim jsqte As Integer
Bclrsj = False
'文本检查
With RecSettlement
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 8) = 1 Then '字段不能为空
If Len(Trim(LrText(jsqte).Text)) = 0 Then
Tsxx = Textstr(jsqte, 7) & "不能为空!"
Call Xtxxts(Tsxx, 0, 1)
LrText(jsqte).SetFocus
Bclrsj = False
Exit Function
End If
Else
If Textint(jsqte, 8) = 2 Then '字段不能为零
If Val(Trim(LrText(jsqte).Text)) = 0 Then
Tsxx = Textstr(jsqte, 7) & "不能为零!"
Call Xtxxts(Tsxx, 0, 1)
LrText(jsqte).SetFocus
Bclrsj = False
Exit Function
End If
End If
End If
Next jsqte
'对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
If Not TextYxxpd(jsqte) Then
Exit Function
End If
End If
Next jsqte
On Error GoTo Swcwcl
If Lrzt = 1 Then '增 加
'数据判断
If Len(Trim(LrText(0))) <> 2 Then
Tsxx = "请录入二位成本对象编码!"
Call Xtxxts(Tsxx, 0, 1)
LrText(0).SetFocus
Bclrsj = False
Exit Function
End If
SqlStr = "SELECT * FROM Cb_CostObject WHERE ObjectCode= '" + Trim(LrText(0).Text) + "'"
Set RecSettlement = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not RecSettlement.EOF Then
Tsxx = "成本对象编码重复!"
Call Xtxxts(Tsxx, 0, 1)
LrText(0).SetFocus
Bclrsj = False
Exit Function
End If
SqlStr = "SELECT * FROM Cb_CostObject WHERE ObjectName= '" + Trim(LrText(1).Text) + "'"
Set RecSettlement = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not RecSettlement.EOF Then
Tsxx = "成本项目名称重复!"
Call Xtxxts(Tsxx, 0, 1)
LrText(1).SetFocus
Bclrsj = False
Exit Function
End If
'写入数据
If .State = 1 Then .Close
SqlStr = "Select * From Cb_CostObject Where 1=2"
.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
.AddNew
.Fields("ObjectCode") = Trim(LrText(0).Text) '对象编码
.Fields("ObjectName") = Trim(LrText(1).Text) '对象名称
SqlStr = "Select ObjectTypeCode From CB_ObjectType Where ObjectTypeName='" + Trim(LrText(2).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("ObjectTypeCode") = "" '对象类别
Else
.Fields("ObjectTypeCode") = Cxnrrec.Fields("ObjectTypeCode") '对象类别
End If
SqlStr = "Select UnitCode From GY_UnitSet Where UnitName='" + Trim(LrText(3).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("MeasureUnitCode") = Null '单位名称
Else
.Fields("MeasureUnitCode") = Cxnrrec.Fields("UnitCode") '单位名称
End If
If Trim(LrText(4).Text) = "" Then
.Fields("PlanQuantity") = 0 '计划数量
Else
.Fields("PlanQuantity") = Trim(LrText(4).Text) '计划数量
End If
If Trim(LrText(5).Text) = "" Then
.Fields("PlanCost") = 0 '计划成本
Else
.Fields("PlanCost") = Trim(LrText(5).Text) '计划成本
End If
SqlStr = "Select CCode From Cwzz_AccCode Where CName='" + Trim(LrText(6).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("Ccode") = "" '结转科目
Else
.Fields("Ccode") = Cxnrrec.Fields("CCode") '结转科目
End If
If Trim(LrText(7).Text) <> "" Then
.Fields("CalOrder") = Trim(LrText(7).Text) '计算顺序
Else
.Fields("CalOrder") = 1
End If
SqlStr = "Select CenterCode From CB_CostCenter Where CenterName='" + Trim(LrText(8).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("CenterCode") = "" '成本中心
Else
.Fields("CenterCode") = Cxnrrec.Fields("CenterCode") '成本中心
End If
.Update
'显示数据
SqlStr = "Select Objectcode,ObjectName,ObjectTypeName,UnitName,PlanQuantity,PlanCost, " _
& "CName,CalOrder,D.CenterName From CB_CostObject A " _
& "Left Outer Join GY_UnitSet B On A.MeasureUnitCode=B.UnitCode " _
& "Left Outer Join CB_ObjectType C On A.ObjectTypeCode=C.ObjectTypeCode " _
& "Left Outer Join CB_CostCenter D On A.CenterCode=D.CenterCode " _
& "Left Outer Join Cwzz_AccCode E On A.CCode=E.CCode " _
& "Where Objectcode='" + Trim(LrText(0).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With CzxsGrid
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
.Select .Rows - 1, Qslz
Call Jltcwg(Cxnrrec, .Rows - 1)
End With
Tsxx = "保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Call Cshlrxx(1)
LrText(0).SetFocus
Else
'数据判断
SqlStr = "SELECT * FROM Cb_CostObject WHERE ObjectName= '" + Trim(LrText(1).Text) + "' And ObjectCode<>'" + Trim(LrText(0).Text) + "'"
Set RecSettlement = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not RecSettlement.EOF Then
Tsxx = "成本对象名称重复!"
Call Xtxxts(Tsxx, 0, 1)
LrText(1).SetFocus
Bclrsj = False
Exit Function
End If
'写入数据
If .State = 1 Then .Close
SqlStr = "SELECT * FROM Cb_CostObject WHERE ObjectCode= '" + Trim(LrText(0).Text) + "'"
.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
.Fields("ObjectName") = Trim(LrText(1).Text) '对象名称
SqlStr = "Select ObjectTypeCode From CB_ObjectType Where ObjectTypeName='" + Trim(LrText(2).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("ObjectTypeCode") = "" '对象类别
Else
.Fields("ObjectTypeCode") = Cxnrrec.Fields("ObjectTypeCode") '对象类别
End If
SqlStr = "Select UnitCode From GY_UnitSet Where UnitName='" + Trim(LrText(3).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("MeasureUnitCode") = Null '单位名称
Else
.Fields("MeasureUnitCode") = Cxnrrec.Fields("UnitCode") '单位名称
End If
If Trim(LrText(4).Text) = "" Then
.Fields("PlanQuantity") = 0 '计划数量
Else
.Fields("PlanQuantity") = Trim(LrText(4).Text) '计划数量
End If
If Trim(LrText(5).Text) = "" Then
.Fields("PlanCost") = 0 '计划成本
Else
.Fields("PlanCost") = Trim(LrText(5).Text) '计划成本
End If
SqlStr = "Select CCode From Cwzz_AccCode Where CName='" + Trim(LrText(6).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("Ccode") = "" '结转科目
Else
.Fields("Ccode") = Cxnrrec.Fields("CCode") '结转科目
End If
If Trim(LrText(7).Text) <> "" Then
.Fields("CalOrder") = Trim(LrText(7).Text) '计算顺序
Else
.Fields("CalOrder") = 1
End If
SqlStr = "Select CenterCode From CB_CostCenter Where CenterName='" + Trim(LrText(8).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Cxnrrec.EOF Then
.Fields("CenterCode") = "" '成本中心
Else
.Fields("CenterCode") = Cxnrrec.Fields("CenterCode") '成本中心
End If
.Update
End If
'显示数据
SqlStr = "Select Objectcode,ObjectName,ObjectTypeName,UnitName,PlanQuantity,PlanCost, " _
& "CName,CalOrder,D.CenterName From CB_CostObject A " _
& "Left Outer Join GY_UnitSet B On A.MeasureUnitCode=B.UnitCode " _
& "Left Outer Join CB_ObjectType C On A.ObjectTypeCode=C.ObjectTypeCode " _
& "Left Outer Join CB_CostCenter D On A.CenterCode=D.CenterCode " _
& "Left Outer Join Cwzz_AccCode E On A.CCode=E.CCode " _
& "Where Objectcode='" + Trim(LrText(0).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not Cxnrrec.EOF Then
With CzxsGrid
Call Jltcwg(Cxnrrec, .Row)
End With
End If
End If
Bclrsj = True
Exit Function
End With
Swcwcl:
Tsxx = "存盘过程中出现错误,请退出后重新进入!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End Function
Private Sub Cshlrxx(lrztxx As Integer) '初始化录入字段信息
TextChangeLock = True '关闭Chang事件
If lrztxx = 1 Then
For jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
TextChangeLock = True
LrText(jsqte).Text = ""
LrText(jsqte).Tag = ""
TextChangeLock = False
End If
TextValiJudgeLock(jsqte) = True
Next jsqte
Else
With CzxsGrid
LrText(0).Text = Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) '对象代码
LrText(1).Text = Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))) '对象名称
LrText(2).Text = Trim(.TextMatrix(.Row, Sydz("003", GridStr(), Szzls))) '对象类型
LrText(3).Text = Trim(.TextMatrix(.Row, Sydz("004", GridStr(), Szzls))) '计量单位
LrText(4).Text = Trim(.TextMatrix(.Row, Sydz("005", GridStr(), Szzls))) '计划产量
LrText(5).Text = Trim(.TextMatrix(.Row, Sydz("006", GridStr(), Szzls))) '计划成本
LrText(6).Text = Trim(.TextMatrix(.Row, Sydz("007", GridStr(), Szzls))) '结转科目
LrText(7).Text = Trim(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls))) '计算顺序
LrText(8).Text = Trim(.TextMatrix(.Row, Sydz("009", GridStr(), Szzls))) '成本中心
End With
End If
TextChangeLock = False
End Sub
Private Sub Scdqjl() '删 除 当 前 记 录
Dim yhAnswer As Integer
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
If CzxsGrid.Row < CzxsGrid.FixedRows Then
Exit Sub
End If
Tsxx = "请确认是否删除当前记录?"
yhAnswer = Xtxxts(Tsxx, 2, 2)
If yhAnswer = 2 Then
Exit Sub
End If
On Error GoTo Cwcl
'[以下需自定义部分
'判断是否能够删除
SqlStr = "Select Count(*) From Cb_CostStructure Where Objectcode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If RecTemp.Fields(0) > 0 Then
Tsxx = "该成本对象已经被使用,不能删除!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
SqlStr = "Select Count(*) From Cb_ObjectComplete Where Objectcode= '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If RecTemp.Fields(0) > 0 Then
Tsxx = "该成本对象已经被使用,不能删除!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
'删除数据
Cw_DataEnvi.DataConnect.Execute "Delete Cb_CostObject where ObjectCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
'以上为自定义部分]
CzxsGrid.RemoveItem CzxsGrid.Row
Exit Sub
Cwcl:
If Err.Number = -2147217900 Then
Tsxx = "该编码已经被使用,不能删除!"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -