📄
字号:
With RecTemp
WglrGrid.Clear 1
WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
Jsqte = WglrGrid.FixedRows
Do While Not .EOF
If Jsqte >= WglrGrid.Rows Then
WglrGrid.AddItem ""
End If
WglrGrid.TextMatrix(Jsqte, 0) = "*" '有效记录标识
WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("I_id")) '记录唯一标识
WglrGrid.TextMatrix(Jsqte, 2) = Trim(.Fields("CCode"))
WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Cname"))
WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = IIf(.Fields("Budget_1") = 0, "", .Fields("budget_1"))
WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = IIf(.Fields("Add_1") = 0, "", .Fields("Add_1"))
WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = IIf(.Fields("Budget_2") = 0, "", .Fields("budget_2"))
WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = IIf(.Fields("Add_2") = 0, "", .Fields("Add_2"))
WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = IIf(.Fields("Budget_3") = 0, "", .Fields("budget_3"))
WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = IIf(.Fields("Add_3") = 0, "", .Fields("Add_3"))
WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = IIf(.Fields("Budget_4") = 0, "", .Fields("budget_4"))
WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = IIf(.Fields("Add_4") = 0, "", .Fields("Add_4"))
WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = IIf(.Fields("Budget_5") = 0, "", .Fields("budget_5"))
WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = IIf(.Fields("Add_5") = 0, "", .Fields("Add_5"))
WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = IIf(.Fields("Budget_6") = 0, "", .Fields("budget_6"))
WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = IIf(.Fields("Add_6") = 0, "", .Fields("Add_6"))
WglrGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = IIf(.Fields("Budget_7") = 0, "", .Fields("budget_7"))
WglrGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = IIf(.Fields("Add_7") = 0, "", .Fields("Add_7"))
WglrGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = IIf(.Fields("Budget_8") = 0, "", .Fields("budget_8"))
WglrGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = IIf(.Fields("Add_8") = 0, "", .Fields("Add_8"))
WglrGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = IIf(.Fields("Budget_9") = 0, "", .Fields("budget_9"))
WglrGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = IIf(.Fields("Add_9") = 0, "", .Fields("Add_9"))
WglrGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = IIf(.Fields("Budget_10") = 0, "", .Fields("budget_10"))
WglrGrid.TextMatrix(Jsqte, Sydz("021", GridStr(), Szzls)) = IIf(.Fields("Add_10") = 0, "", .Fields("Add_10"))
WglrGrid.TextMatrix(Jsqte, Sydz("022", GridStr(), Szzls)) = IIf(.Fields("Budget_11") = 0, "", .Fields("budget_11"))
WglrGrid.TextMatrix(Jsqte, Sydz("023", GridStr(), Szzls)) = IIf(.Fields("Add_11") = 0, "", .Fields("Add_11"))
WglrGrid.TextMatrix(Jsqte, Sydz("024", GridStr(), Szzls)) = IIf(.Fields("Budget_12") = 0, "", .Fields("budget_12"))
WglrGrid.TextMatrix(Jsqte, Sydz("025", GridStr(), Szzls)) = IIf(.Fields("Add_12") = 0, "", .Fields("Add_12"))
Cur_SumBudget = .Fields("Budget_1") + .Fields("Budget_2") + .Fields("Budget_3") + .Fields("Budget_4") + _
.Fields("Budget_5") + .Fields("Budget_6") + .Fields("Budget_7") + .Fields("Budget_8") + _
.Fields("Budget_9") + .Fields("Budget_10") + .Fields("Budget_11") + .Fields("Budget_12") + _
.Fields("Add_1") + .Fields("Add_2") + .Fields("Add_3") + .Fields("Add_4") + .Fields("Add_5") + _
.Fields("Add_6") + .Fields("Add_7") + .Fields("Add_8") + .Fields("Add_9") + .Fields("Add_10") + _
.Fields("Add_11") + .Fields("Add_12")
WglrGrid.TextMatrix(Jsqte, Sydz("026", GridStr(), Szzls)) = IIf(Cur_SumBudget = 0, "", Cur_SumBudget)
WglrGrid.TextMatrix(Jsqte, Sydz("027", GridStr(), Szzls)) = IIf(.Fields("YearBudget") = 0, "", .Fields("YearBudget"))
'<<]
WglrGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Jsqte = Jsqte + 1
Loop
End With
'调整网格
Call Sub_AdjustGrid
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
Dim Msg, Style, Title, Response
'屏蔽文本框,下拉组合框有效性判断
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 "dr" '导入
Msg = "导入将替换本年已录入的相同科目的预算数据?" ' 定义信息。
Style = vbYesNo + vbDefaultButton2 + vbExclamation ' 定义按钮。
Title = "百利/ERP财务分析系统5.0" ' 定义标题。
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' 用户按下“是”。
Call ImportFromLastYear
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))
Select Case GridStr(Dqpdwgl, 1)
'以下为自定义部分[
'1.放置字段有效性判断程序
Case "001" '科目(如有效则调入科目编码)
If Len(Str_JudgeText) <> 0 Then
SqlStr = "Select * FROM Cwzz_AccCode Where CCode='" & Str_JudgeText & "' OR CName='" & 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("CCode"))
WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("CName"))
End With
'判断记录是否重复
SqlStr = "SELECT Cwfx_AccountBudgetMaster.I_id From Cwfx_AccountBudgetMaster WHERE Ccode='" & WglrGrid.TextMatrix(Dqpdwgh, 2) & "'And Year=" & Str(Int_OriYear)
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not RecTemp.EOF Then
If RecTemp.Fields("I_ID") <> Val(WglrGrid.TextMatrix(Dqpdwgh, 1)) Then
Tsxx = "录入记录重复!"
Dqpdwgl = Sydz("001", GridStr(), Szzls)
GoTo Lrcwcl
End If
End If
Else
WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""
End If
'2.放置字段事后处理程序
'科目所要进行核算项不能为空
If (Not .ColHidden(Sydz("001", GridStr(), Szzls))) And Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) = "" Then
Tsxx = "预算项目不能为空!"
Lrywlz = Sydz("001", GridStr(), Szzls)
GoTo Lrcwcl
End If
'以上为自定义部分]
End Select
'2.放置字段事后处理程序
Cur_SumBudget = 0
For I = 2 To 25
Cur_SumBudget = Cur_SumBudget + Val(WglrGrid.TextMatrix(Dqpdwgh, Sydz(IIf(I > 9, "0", "00") + Trim(Str(I)), GridStr(), Szzls)))
Next
WglrGrid.TextMatrix(Dqpdwgh, Sydz("026", GridStr(), Szzls)) = IIf(Cur_SumBudget = 0, "", Cur_SumBudget)
'字段录入正确后为零字段清空
Call Qkwlzd(Dqpdwgh, Dqpdwgl)
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 Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean '录入数据行有效性判断,同时进行行处理
Dim Lrywlz As Long
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim SqlStr As String '临时连接字符串
Dim Rec_AccSumAssi As New ADODB.Recordset '辅助总帐动态集
Dim Dbl_Now(1 To 16) As Double '科目记录现数据
Dim Str_OriItemCode As String '辅助核算项目编码(原)
Dim Str_NowItemCode As String '辅助核算项目编码(现)
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
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
'科目所要进行核算项不能为空
If (Not .ColHidden(Sydz("001", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls))) = "" Then
Tsxx = "预算科目不能为空!"
Lrywlz = Sydz("001", GridStr(), Szzls)
GoTo Lrcwcl
End If
'判断记录是否重复
SqlStr = "SELECT Cwfx_AccountBudgetMaster.I_id From Cwfx_AccountBudgetMaster WHERE Ccode='" & WglrGrid.TextMatrix(Yxxpdh, 2) & "'And Year=" & Str(Int_OriYear)
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not RecTemp.EOF Then
If RecTemp.Fields("I_ID") <> Val(WglrGrid.TextMatrix(Yxxpdh, 1)) Then
Tsxx = "录入记录重复!"
For Jsqte = Qslz To WglrGrid.Cols - 1
If Not WglrGrid.ColHidden(Jsqte) Then
Lrywlz = Jsqte
End If
Next Jsqte
Lrywlz = Sydz("001", GridStr(), Szzls)
GoTo Lrcwcl
End If
End If
'2.进行行数据回写
End With
On Error GoTo Swcwcl
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -