📄
字号:
End With '网格
'如果以上有效性检查均顺利通过,则执行存盘动作
On Error GoTo Swcwcl
If TreeNots_Code = "" Then
Exit Function
End If
'写数据
Cw_DataEnvi.DataConnect.BeginTrans
For Rowjsq = CzxsGrid.FixedRows To CzxsGrid.Rows - 1
SqlStr = "Delete From Cb_Inventory Where CenterCode='" & Trim(CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls))) & "' And ObjectCode='" & Trim(CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls))) & "' And ItemCode='" & Trim(CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) & "' And Year=" & CStr(PrivateYear) & " And Period=" & CStr(PrivateMm) & ""
Cw_DataEnvi.DataConnect.Execute (SqlStr)
If RecDigest.State = 1 Then RecDigest.Close
RecDigest.Open "Select * From Cb_Inventory Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
If RecDigest.EOF Then
If CzxsGrid.TextMatrix(Rowjsq, 0) <> "*" Then
Exit Function
End If
With RecDigest
.AddNew
.Fields("ItemCode") = Trim(CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) '项目编码
.Fields("CenterCode") = Trim(CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls))) '成本中心
.Fields("Objectcode") = Trim(CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls))) '对象编码
.Fields("Year") = PrivateYear '会计年度
.Fields("Period") = PrivateMm '会计期间
.Fields("PlanUnitCost") = Val(CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))) '计划成本
.Fields("InvQuantity") = Val(CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls))) '盘存数量
.Fields("InvValue") = Val(CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls))) '盘存金额
.Update
End With
End If
Next
Cw_DataEnvi.DataConnect.CommitTrans
Tsxx = "存盘完毕! "
Call Xtxxts(Tsxx, 0, 4)
Sub_SaveBill = True
Lab_OperStatus = "1"
Call Sub_OperStatus("11")
Exit Function
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
If Err.Number = -2147217873 Then
Tsxx = "不能有重复的对象!"
Else
Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
End If
Call Xtxxts(Tsxx, 0, 1)
Exit Function
Lrcwcl: '录入错误处理
Cw_DataEnvi.DataConnect.RollbackTrans
With CzxsGrid
Call Xtxxts("(第 " + Trim(Str(Int_RowCount)) + " 条记录)-" + Tsxx, 0, 1)
Changelock = True
.Select Rowjsq, Lrywlz
CzxsGrid.SetFocus
Changelock = False
Exit Function
End With
End Function
'******************以下为基本处理程序(固定不变)************************'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) '支持热键操作
If Shift = 2 Then
Select Case UCase(Chr(KeyCode))
Case "P" 'Ctrl+P 打印
Call bbyl(False)
End Select
End If
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "ymsz" '页面设置
Dyymctbl.Show 1
Case "yl" '预 览
Call bbyl(True)
Case "dy" '打 印
Call bbyl(False)
Case "xg" '编辑
If CzxsGrid.Rows <= CzxsGrid.FixedRows Then
Exit Sub
End If
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
'设置状态
Lab_OperStatus.Caption = "3"
'设置工具条状态
Call Sub_OperStatus("30")
Case "bc" '保存
If Fun_Drfrmyxxpd Then Call Sub_SaveBill
Case "fq" '放弃
Call Sub_AbandonBill
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
End Select
End Sub
Private Sub CzxsGrid_DblClick() '修改当前编码记录
With CzxsGrid
Call xswbk
End With
End Sub
Private Sub Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
With SzToolbar
Select Case Str_Status
Case "10" '浏览
'工具条
.Buttons("xg").Enabled = False '修改
.Buttons("bc").Enabled = False
.Buttons("fq").Enabled = False
Case "11" '浏览
'工具条
.Buttons("xg").Enabled = True '修改
.Buttons("bc").Enabled = False
.Buttons("fq").Enabled = False
Case "30" '修改
'工具条
.Buttons("xg").Enabled = False '修改
.Buttons("bc").Enabled = True
.Buttons("fq").Enabled = True
End Select
End With
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '表格格式设置(通用)
Select Case Button.Key
Case "bcgs" '保存表格格式
Call Bcwggs(CzxsGrid, GridCode, GridStr())
Case "hfmrgs" '恢复默认格式
Call Hfmrgs(CzxsGrid, GridCode, GridStr())
End Select
End Sub
Private Sub bbyl(bbylte As Boolean) '报表打印预览
Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
Bbxbtgs = 1 '报 表 小 标 题 行 数
Bbbwhgs = 0 '报 表 表 尾 行 数
ReDim Bbxbt(1 To Bbxbtgs)
ReDim bbxbtzzxs(1 To Bbxbtgs)
If Bbbwhgs <> 0 Then
ReDim Bbbwh(1 To Bbbwhgs)
ReDim Bbbwhzzxs(1 To Bbbwhgs)
End If
Bbzbt = ReportTitle
Tree_List.SetFocus
'判断是否有数据
SqlStr = "Select count(*) From Cb_CostStructure Where CheckFlag='1'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If RecTemp.Fields(0) <= 0 Then
Bbxbt(1) = Space(2) + "成本对象:"
Else
Tree_List.SetFocus
If Tree_List.SelectedItem.Children = 0 Then
Bbxbt(1) = Space(2) + Fun_FormatOutPut("成本对象:" + Tree_List.SelectedItem.Text, 42)
Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut(Mid(CStr(Combo_KJQJ.List(Combo_KJQJ.ListIndex)), 1, 4) + "年" + Right(CStr(Combo_KJQJ.List(Combo_KJQJ.ListIndex)), 2) + "月", 35)
Else
Bbxbt(1) = Space(2) + "成本对象:"
End If
End If
bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
Call Scyxsjb(CzxsGrid) '生成报表数据
Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
If Not bbylte Then
Unload DY_Tybbyldy
End If
End Sub
'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer) '文本框录入事后处理程序
'以下为依据实际情况自定义部分[
'在此填写文本框录入事后处理程序
']以上为依据实际情况自定义部分
End Sub
Private Sub Tree_List_NodeClick(ByVal Node As MSComctlLib.Node)
Dim code_row As Integer
Dim ff As String
On Error Resume Next
With CzxsGrid
code_row = .FindRow(Trim(Mid(Tree_List.SelectedItem.Key, 2)), , Sydz("001", GridStr(), Szzls))
If code_row <> -1 Then
.Select code_row, 0
End If
End With
'隐藏文本框
Call Ycwbk
If Tree_List.SelectedItem.Children = 0 Then
TreeNots_Code = Right(Mid(Trim(Tree_List.SelectedItem.Key), 2, Len(Trim(Tree_List.SelectedItem.Key)) - 1), 2)
Call ShowCostInventory
Else
TreeNots_Code = ""
Call ShowCostInventory
Lab_Row = ""
End If
End Sub
Private Sub TextShow(Index As Integer) '文本框得到焦点,显示相应信息
'填写文本框得到焦点,进行相应信息处理程序
End Sub
Private Sub Lrsjhx() '文本框录入数据回写
With CzxsGrid
If YdCombo.Visible Then .Text = Trim(YdCombo.Text)
If Ydtext.Visible Then .Text = Trim(Ydtext.Text)
'(如果字段录入内容发生变化,则打开有效性判断锁)
If Zdlrqnr <> Trim(.Text) Then
Yxxpdlock = False
Hyxxpdlock = False
End If
'如果字段录入内容不为空则写数据行有效性标志
If Len(Trim(.Text)) <> 0 Then
Call Xyxhbz(.Row)
End If
'隐藏文本框,帮助按钮,列表组合框
Call Ycwbk
End With
End Sub
Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean '录入数据行有效性判断,同时进行行处理
Dim Lrywlz As Long
With CzxsGrid
'判断行是否为空和无效数据行清除
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
End If
'行没有发生变化则不进行有效性判断
If Hyxxpdlock Then
Sjhzyxxpd = True
Exit Function
End If
'以下为自定义部分[
'1.放置行有效性判断程序
'首先进行为空判断(固定不变)
For jsqte = Qslz To .Cols - 1
If (GridInt(jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0) Or (GridInt(jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0) Then
Tsxx = GridStr(jsqte, 2)
Lrywlz = jsqte
GoTo Lrcwcl
Exit For
End If
Next jsqte
End With
Sjhzyxxpd = True
Hyxxpdlock = True
Exit Function
Lrcwcl: '录入错误处理
With CzxsGrid
Call Xtxxts(Tsxx, 0, 1)
Changelock = True
.Select Yxxpdh, Lrywlz
Changelock = False
Call xswbk
Sjhzyxxpd = False
Exit Function
End With
End Function
Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) '录入数据字段有效性判断,同时进行字段录入事后处理
Dim Str_JudgeText As String '临时有效性判断字段内容
Dim Coljsq As Long '临时列计数器
With CzxsGrid
'非录入状态有效性为合法
If Yxxpdlock Or .Row < .FixedRows Then
sjzdyxxpd = True
Exit Function
End If
Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
End With
Select Case GridStr(Dqpdwgl, 1)
'以下为自定义部分[
Case "006" '实际数量
If Len(Str_JudgeText) <> 0 Then
If Trim(CzxsGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))) <> "" Then
CzxsGrid.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = CStr(Format(Val(CzxsGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))) * Val(CzxsGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))), "0.00"))
Else
CzxsGrid.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = ""
End If
End If
End Select
'根据转帐性质，判断按转帐科目号取项目大类还是按来源科目取项目大类
'字段录入正确后为零字段清空
Call Qkwlzd(Dqpdwgh, Dqpdwgl)
sjzdyxxpd = True
Yxxpdlock = True
Exit Function
Lrcwcl: '录入错误处理
With CzxsGrid
Call Xtxxts(Tsxx, 0, 1)
Changelock = True
.Select Dqpdwgh, Dqpdwgl
If GridBoolean(.Col, 1) = True Then
Changelock = False
Call xswbk
sjzdyxxpd = False
End If
End With
Exit Function
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -