企业管理

开发平台：

Visual Basic

：源码内容

For Coljsq = Qslz To WglrGrid.Cols - 1
Call Sjhj(Coljsq)
Next Coljsq
'重新显示辅助核算信息
Call Sub_ShowMemo(WglrGrid.Row)
End If
End Sub
Private Sub Kmfzhsx(Lng_GridRow As Long) '调用科目辅助核算项
'过程函数;Lng_gridrow当前网格调入辅助核算行
Dim Kjqstop#, Kjqsleft#, Kjjg#, Ctzxgd#, Kjxsgs%, jsqte%
Dim rectemp As New ADODB.Recordset '临时使用动态集
Kjqstop = 300 '控件显示起始高度
Kjqsleft = 300 '控件显示起始左边界
Kjjg = 450 '控件显示间隔
Kjxsgs = 0 '控件显示个数
Ctzxgd = 1500 '窗体显示最小高度
With AutoTran_PzAss '辅助核算项目窗体
.Caption = "辅助核算项目_" + Trim(WglrGrid.TextMatrix(Lng_GridRow, Sydz("003", GridStr(), Szzls)))
For jsqte = 0 To Int_AssCount - 1
If Bln_AssShow(jsqte) Then
.TsLabel(jsqte).Visible = True
.TsLabel(jsqte).Move Kjqsleft, Kjqstop + Kjxsgs * Kjjg
.LrText(jsqte).Visible = True
.LrText(jsqte).Move .TsLabel(jsqte).Left + .TsLabel(jsqte).Width + 50, .TsLabel(jsqte).Top - 100
If Bln_AssHelp(jsqte) Then
.Ydcommand1(jsqte).Visible = True
.Ydcommand1(jsqte).Move .LrText(jsqte).Left + .LrText(jsqte).Width, .LrText(jsqte).Top, .Ydcommand1(jsqte).Width, .LrText(jsqte).Height
End If
Kjxsgs = Kjxsgs + 1
Select Case jsqte
Case 0 '结算方式
.LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 1))
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 2))
Case 1 '票号
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 3))
Case 2 '发生日期
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 4))
Case 3 '数量
.LrText(jsqte).Text = WglrGrid.TextMatrix(Lng_GridRow, 5)
.Lab_Measure = Trim(WglrGrid.TextMatrix(Lng_GridRow, 7))
.Lab_Measure.Move .LrText(jsqte).Left + .LrText(jsqte).Width + 50, .LrText(jsqte).Top + 100
Case 4 '单价
If Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) <> 0 And Val(WglrGrid.TextMatrix(Lng_GridRow, 5)) <> 0 Then
.LrText(jsqte).Text = Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) / Val(WglrGrid.TextMatrix(Lng_GridRow, 5))
Else
If Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) <> 0 And Val(WglrGrid.TextMatrix(Lng_GridRow, 5)) <> 0 Then
.LrText(jsqte).Text = Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) / Val(WglrGrid.TextMatrix(Lng_GridRow, 5))
End If
End If
Case 5 '外币金额
.LrText(jsqte).Text = WglrGrid.TextMatrix(Lng_GridRow, 10)
.Lab_ForeignName.Caption = "(" + Trim(WglrGrid.TextMatrix(Lng_GridRow, 9)) + ")"
.Lab_ForeignName.Move .LrText(jsqte).Left + .LrText(jsqte).Width + 50, .LrText(jsqte).Top + 100
Case 6 '汇率
.LrText(jsqte).Text = WglrGrid.TextMatrix(Lng_GridRow, 11)
Case 7 '部门
.LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 12))
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 13))
Case 8 '客户
.LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 14))
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 15))
Case 9 '个人
.LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 16))
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 17))
Case 10 '项目
.Lab_ItemClass.Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 18))
.Lab_ItemClass.Caption = "(" + Trim(WglrGrid.TextMatrix(Lng_GridRow, 19)) + ")"
.Lab_ItemClass.Move .LrText(jsqte).Left + .LrText(jsqte).Width + 400, .LrText(jsqte).Top + 100
.LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 20))
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 21))
SqlStr = "select * from Cwzz_item where ItemClassCode='" & .Lab_ItemClass.Tag & "' and ItemCode='" & Trim(.LrText(10).Tag) & "'"
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not rectemp.EOF Then
If rectemp.Fields("QuantityFlag") Then
.LrText(11).Text = WglrGrid.TextMatrix(Lng_GridRow, 22)
.Lab_ItemMeasure = Trim(rectemp.Fields("Measure"))
End If
End If
Case 11
.Lab_ItemMeasure.Move .LrText(11).Left + .LrText(11).Width + 50, .LrText(11).Top + 50
Case 12 '供应商
.LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 25))
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 26))
Case 13 '经办人
.LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 24))
End Select
Else
.TsLabel(jsqte).Visible = False
.LrText(jsqte).Visible = False
If Bln_AssHelp(jsqte) Then
.Ydcommand1(jsqte).Visible = False
End If
End If
Next jsqte
If Kjqstop * 3 + Kjxsgs * Kjjg > Ctzxgd Then
.Height = Kjqstop * 3 + Kjxsgs * Kjjg
Else
.Height = Ctzxgd
End If
'加锁
changelock = True
.Show 1
changelock = False
End With
End Sub
Private Sub Sub_ShowMemo(Lng_GridRow) '显示网格备注项
'函数参数:网格行
Dim Str_Memo As String
Str_Memo = ""
With WglrGrid
If Len(Trim(.TextMatrix(Lng_GridRow, 2))) <> 0 Then
Str_Memo = Str_Memo + "结算方式:" + Trim(.TextMatrix(Lng_GridRow, 2)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 3))) <> 0 Then
Str_Memo = Str_Memo + "票号:" + Trim(.TextMatrix(Lng_GridRow, 3)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 4))) <> 0 Then
Str_Memo = Str_Memo + "发生日期:" + Trim(.TextMatrix(Lng_GridRow, 4)) + Space(2)
End If
If Val(.TextMatrix(Lng_GridRow, 5)) <> 0 Then
Str_Memo = Str_Memo + "数量:" + Format(Trim(.TextMatrix(Lng_GridRow, 5)), "#,##0." + String(Xtslxsws, "0")) + Trim(.TextMatrix(Lng_GridRow, 7)) + Space(2)
End If
'显示单价
If Val(.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) <> 0 And Val(.TextMatrix(Lng_GridRow, 5)) <> 0 Then
Str_Memo = Str_Memo + "单价:" + Format(Val(.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) / Val(.TextMatrix(Lng_GridRow, 5)), "#,##0." + String(Xtdjxsws, "0"))
Else
If Val(.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) <> 0 And Val(.TextMatrix(Lng_GridRow, 5)) <> 0 Then
Str_Memo = Str_Memo + "单价:" + Format(Val(.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) / Val(.TextMatrix(Lng_GridRow, 5)), "#,##0." + String(Xtdjxsws, "0"))
End If
End If
If Val(.TextMatrix(Lng_GridRow, 10)) <> 0 Then
Str_Memo = Str_Memo + "外币:" + Format(Trim(.TextMatrix(Lng_GridRow, 10)), "#,##0." + String(Xtjexsws, "0")) + Trim(WglrGrid.TextMatrix(Lng_GridRow, 9)) + Space(2)
End If
If Val(.TextMatrix(Lng_GridRow, 11)) <> 0 Then
Str_Memo = Str_Memo + "汇率:" + Trim(.TextMatrix(Lng_GridRow, 11)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 13))) <> 0 Then
Str_Memo = Str_Memo + "部门:" + Trim(.TextMatrix(Lng_GridRow, 13)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 15))) <> 0 Then
Str_Memo = Str_Memo + "客户:" + Trim(.TextMatrix(Lng_GridRow, 15)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 26))) <> 0 Then
Str_Memo = Str_Memo + "供应商:" + Trim(.TextMatrix(Lng_GridRow, 26)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 17))) <> 0 Then
Str_Memo = Str_Memo + "个人:" + Trim(.TextMatrix(Lng_GridRow, 17)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 21))) <> 0 Then
Str_Memo = Str_Memo + "项目类别:" + Trim(.TextMatrix(Lng_GridRow, 19)) + Space(2) + "核算项目:" + Trim(.TextMatrix(Lng_GridRow, 21)) + Space(2)
End If
If Val(.TextMatrix(Lng_GridRow, 22)) <> 0 Then
Str_Memo = Str_Memo + "项目数量:" + Trim(.TextMatrix(Lng_GridRow, 22)) + Trim(.TextMatrix(Lng_GridRow, 23)) + Space(2)
End If
If Len(Trim(.TextMatrix(Lng_GridRow, 24))) <> 0 Then
Str_Memo = Str_Memo + "经办人:" + Trim(.TextMatrix(Lng_GridRow, 24))
End If
Lab_Memo(0).Caption = Str_Memo
Lab_Memo(0).Refresh
End With
End Sub
Private Sub Sub_AbandonBill() '放弃对当前单据的操作
'先关闭录入载体
changelock = True
Valilock = True
Call Ycwbk
changelock = False
Valilock = False
Select Case Trim(Lab_OperStatus.Caption)
Case "2" '修改状态
'重新显示当前单据
Call Sub_ShowBill
'设置操作状态重新置为新增状态
Lab_OperStatus = "2"
Call Sub_OperStatus("30")
End Select
End Sub
Private Sub Combo_Kjqj_Click() '会计期间发生变化则自动计算单据编号
Call Sub_JsVouchNo
End Sub
Private Sub Sub_JsVouchNo() '自动计算新增单据编号
Dim rectemp As New ADODB.Recordset '临时使用动态集
'单据为新增时才有效
If Lab_OperStatus <> "2" Then
Exit Sub
End If
SqlStr = "Select MAX(VouchNo) AS MVouchNo FROM Cwzz_AccVouchMain Where Year='" & Int_Year & "' AND Period='" & Int_Period & "'" & _
" AND VouchClassCode='" & Trim(LrText(0).Text) & "'"
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
TextChangeLock = True
If Not IsNull(rectemp.Fields("MVouchNo")) Then
LrText(3).Text = Mid(Trim(Str(10000 + rectemp.Fields("MVouchNo") + 1)), 2, 4)
Else
LrText(3).Text = "0001"
End If
TextChangeLock = False
End Sub
Private Function Sub_SaveBill() As Boolean '保存单据
Dim Recfind As New ADODB.Recordset '有效性判断动态集
Dim Rec_AccVouchMain As New ADODB.Recordset '凭证主表动态集
Dim Rec_AccVouch As New ADODB.Recordset '凭证子表动态集
Dim Rec_Ass As New ADODB.Recordset '辅助项目记录集
Dim jsqte As Integer '临时计数器
Dim Rowjsq As Long '网格行计数器
Dim Coljsq As Long '网格列计数器
Dim Int_RowCount As Integer '有效数据行计数器
Dim Bln_AssVali As Boolean '辅助核算错误标识
Dim Lrywlz As Long '录入有误列值
Dim Dbl_Jfhj As Double '借方合计
Dim Dbl_Dfhj As Double '贷方合计
Dim int_sUreVouchId As Integer
int_sUreVouchId = 0
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)
If LrText(jsqte).Enabled = True Then LrText(jsqte).SetFocus
Sub_SaveBill = 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)
If LrText(jsqte).Enabled = True Then LrText(jsqte).SetFocus
Sub_SaveBill = 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
'[判断用户所选会计期间是否有效(非结帐月份),且制单日期必须和所选会计期间一致
SqlStr = "Select * FROM gy_Kjrlb Where KjYear=" & Mid(Combo_Kjqj.Text, 1, 4) & " AND period=" & Mid(Combo_Kjqj.Text, 6, 2)
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With rectemp
If Not .EOF Then
If .Fields("Cwzzjzbz") Then
Tsxx = "所选会计期间已经结帐,不能再填制凭证!"
Call Xtxxts(Tsxx, 0, 1)
Combo_Kjqj.SetFocus
Exit Function
End If
If Not (Format(CDate(LrText(1).Text), "yyyy-mm-dd") >= Format(.Fields("Qsrq"), "yyyy-mm-dd") And Format(CDate(LrText(1).Text), "yyyy-mm-dd") <= Format(.Fields("Zzrq"), "yyyy-mm-dd")) Then
Tsxx = "制单日期应在所选会计期间范围内!"
Call Xtxxts(Tsxx, 0, 1)
LrText(1).SetFocus
Exit Function
End If
End If
End With
'下面将对所有有效数据行进行有效性判断
Int_RowCount = 0
Dbl_Jfhj = 0
Dbl_Dfhj = 0
With WglrGrid
For Rowjsq = .FixedRows To .Rows
'带*号者为有效数据行
If .TextMatrix(Rowjsq, 0) <> "*" Then
Exit For
Else
Int_RowCount = Int_RowCount + 1
End If
'1.首先进行为空或为零判断(固定不变)
For Coljsq = Qslz To .Cols - 1
If (GridInt(Coljsq, 5) = 1 And Len(Trim(.TextMatrix(Rowjsq, Coljsq))) = 0) Or (GridInt(Coljsq, 5) = 2 And Val(Trim(.TextMatrix(Rowjsq, Coljsq))) = 0) Then
Tsxx = GridStr(Coljsq, 2)
Lrywlz = Coljsq
GoTo Lrcwcl
Exit For
End If
Next Coljsq
'2.[自定义判断(补丁)
If Val(Trim(.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))) = 0 And Val(Trim(.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))) = 0 Then
Tsxx = "借方和贷方金额不能同时为零!"
Lrywlz = Sydz("004", GridStr(), Szzls)
GoTo Lrcwcl
End If
If Val(Trim(.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))) <> 0 And Val(Trim(.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))) <> 0 Then
Tsxx = "借方和贷方金额不能同时不为零!"
Lrywlz = Sydz("004", GridStr(), Szzls)
GoTo Lrcwcl
End If
'判断转帐类别是否已停用
SqlStr = "Select * FROM Cwzz_VouchClass where VouchClassCode='" & Trim(LrText(0).Text) & "'"
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If rectemp.EOF = True Then
Tsxx = "该凭证的凭证类别不存在,不能保存!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End If
'判断辅助核算项目是否填写并是否有效
SqlStr = "Select * FROM Cwzz_AccCode Where Ccode='" & Trim(.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) & "'"
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With rectemp
If .EOF Then
Tsxx = "此科目不存在!"
GoTo Lrcwcl
End If
If Not .Fields("EndFlag") Then
Tsxx = "此科目非末级科目!"
GoTo Lrcwcl
End If
If .Fields("StopFlag") Then
Tsxx = "此科目已停用!"
GoTo Lrcwcl
End If
'对于银行科目,如结算方式不为空则结算方式必须有效
If Trim(rectemp.Fields("Cproperty")) = "银行" And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select SSCode FROM Gy_Settlement Where SSCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 1)) & "'")
If Recfind.EOF Then
Tsxx = "此结算方式不存在!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
End If
'如有数量核算且用户选择数量不能为零则数量项不能为零
If rectemp.Fields("QuantityFlag") And Chk_Quantity.Value = 1 And Val(WglrGrid.TextMatrix(Rowjsq, 5)) = 0 Then
Tsxx = "此科目需要数量核算,数量项不能为零!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
'部门核算则部门不能为空且有效
If rectemp.Fields("DeptFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) = 0 Then
Tsxx = "此科目需要部门核算,部门项不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
Else
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select DeptCode FROM Gy_Department Where DeptCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 12)) & "'")
If Recfind.EOF Then
Tsxx = "此部门不存在!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
End If
End If
'往来单位核算则往来单位不能为空
If rectemp.Fields("CusFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) = 0 Then
Tsxx = "此科目需要往来单位核算,往来单位项不能为空"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
Else
If rectemp.Fields("CusFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select CusCode,StopFlag FROM Gy_Customer Where CusCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 14)) & "'")
If Recfind.EOF Then
Tsxx = "此往来单位不存在!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
Else
If Recfind.Fields("StopFlag") = True Then
Tsxx = "此往来单位已停用!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
End If
End If
End If
'个人往来核算则个人项不能为空
If rectemp.Fields("PersonFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) = 0 Then
Tsxx = "此科目需要个人往来核算,个人项不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
Else
If rectemp.Fields("PersonFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select PersonCode FROM Gy_Person Where PersonCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 16)) & "'")
If Recfind.EOF Then
Tsxx = "此个人不存在!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
End If
End If
'项目核算则项目不能为空
If rectemp.Fields("ItemFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) = 0 Then
Tsxx = "此科目需要项目核算,核算项目不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
Else
If rectemp.Fields("ItemFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select ItemCode,QuantityFlag,EndFlag FROM Cwzz_Item Where ItemClassCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 18)) & "' And ItemCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 20)) & "'")
If Recfind.EOF Then
Tsxx = "此核算项目不存在!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
Else
If Recfind.Fields("QuantityFlag") And Val(WglrGrid.TextMatrix(Rowjsq, 22)) = 0 Then
Tsxx = "此项目需数量核算,则项目数量不能为零!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
If Recfind.Fields("EndFlag") = True Then
Tsxx = "此非末级项目!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
End If
End If
End If
End With
'计算借贷方合计数据
Dbl_Jfhj = Dbl_Jfhj + Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))
Dbl_Dfhj = Dbl_Dfhj + Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))
Next Rowjsq
'会计分录行数不能为零
If Int_RowCount = 0 Then
Tsxx = "凭证会计分录行数为零,不能存盘!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End If
'凭证借贷双方合计必须平衡
If Abs(Dbl_Jfhj - Dbl_Dfhj) >= 0.01 Then
Tsxx = "凭证借贷不平衡!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End If
End With '网格
Int_VouchNo = Val(LrText(3).Text) '凭证号
'如果以上有效性检查均顺利通过,则执行存盘动作
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
'写正式凭证
'1.判断凭证号是否重复,如重复则取最大值+1为当前凭证号,否则以当前凭证号存盘
SqlStr = "Select VouchNo From Cwzz_AccVouchMain Where Year=" & Int_Year & " and Period=" & Int_Period & " And VouchClassCode='" & Trim(LrText(0).Text) & "' And VouchNo=" & Val(LrText(3).Text)
Set Rec_AccVouch = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not Rec_AccVouch.EOF Then
If rectemp.State = 1 Then rectemp.Close
SqlStr = "Select MAX(VouchNo) AS MVouchNo FROM Cwzz_AccVouchMain Where Year=" & Mid(Combo_Kjqj.Text, 1, 4) & " AND Period=" & Mid(Combo_Kjqj.Text, 6, 2) & _
" AND VouchClassCode='" & Trim(LrText(0).Text) & "'"
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
TextChangeLock = True
If Not IsNull(rectemp.Fields("MVouchNo")) Then
LrText(3).Text = Mid(Trim(Str(10000 + rectemp.Fields("MVouchNo") + 1)), 2, 4)
Else
LrText(3).Text = "0001"
End If
TextChangeLock = False
Else
TextChangeLock = True
LrText(3).Text = "0001"
TextChangeLock = False
End If
'打开凭证主表动态集
If Rec_AccVouchMain.State = 1 Then Rec_AccVouchMain.Close
Rec_AccVouchMain.Open "Select * From Cwzz_AccVouchMain Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With Rec_AccVouchMain
.AddNew
.Fields("VouchID") = CreatBillID("0101")
.Fields("Year") = Int_Year '会计年度
.Fields("Period") = Int_Period '会计期间
.Fields("Ddate") = CDate(LrText(1).Text) '制单日期
.Fields("VouchClassCode") = Trim(LrText(0).Text) '凭证类别
.Fields("VouchNo") = Val(Trim(LrText(3).Text)) '凭证号
.Fields("Doc") = Val(LrText(2).Text) '附单据数
.Fields("Bill") = Trim(Lab_Bill.Caption) '制单人
.Fields("CheckFlag") = 0 '审核标志置"0"
.Fields("BookFlag") = 0 '记帐标志置"0"
.Fields("VouchSource") = Pub_VouchSource
.Update
int_sUreVouchId = .Fields("VouchID")
End With
'打开凭证子表动态集
If Rec_AccVouch.State = 1 Then Rec_AccVouch.Close
Rec_AccVouch.Open "Select * From Cwzz_AccVouchSub Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows
If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
Exit For
End If
With Rec_AccVouch
.AddNew
.Fields("SerialID") = Rowjsq
.Fields("VouchID") = Rec_AccVouchMain.Fields("VouchId") '凭证ID
.Fields("Digest") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) '摘要
.Fields("Ccode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) '会计科目
.Fields("Jfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) '借方金额
.Fields("Dfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))) '贷方金额
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Jfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5)) '借方数量
Else
.Fields("Dfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5)) '贷方数量
End If
'如为外币核算则原币编码为外币编码否则填充本位币编码,同时填充原币金额
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 8))) <> 0 And Trim(WglrGrid.TextMatrix(Rowjsq, 8)) <> XtSCurrCode Then
.Fields("ForeignCurrCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 8)) '外币编码
.Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, 11)) '记帐汇率
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10)) '本币借方金额
Else
.Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10)) '本币贷方金额
End If
Else
.Fields("ForeignCurrCode") = XtSCurrCode '原币编码
.Fields("AccRate") = 1 '记帐汇率
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) '原币借方金额
Else
.Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))) '原币贷方金额
End If
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) <> 0 Then
.Fields("BillDate") = CDate(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) '发生日期(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
.Fields("SScode") = Trim(WglrGrid.TextMatrix(Rowjsq, 1)) '结算方式(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 3))) <> 0 Then
.Fields("BillNo") = Trim(WglrGrid.TextMatrix(Rowjsq, 3)) '票号(银行)
End If
.Fields("BCheckFlag") = 0 '银行核对标志置0
.Fields("BDelete") = 0 '银行帐核销标志置0
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
.Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 16)) '职员编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
.Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 12)) '部门编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
.Fields("CusCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 14)) '往来客户编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 25))) <> 0 Then
.Fields("Suppliercode") = Trim(WglrGrid.TextMatrix(Rowjsq, 25)) '往来供应商编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 18))) <> 0 Then
.Fields("ItemClassCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 18)) '项目大类编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
.Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 20)) '项目编码
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("ItemJfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22)) '项目借方数量
Else
.Fields("ItemDfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22)) '项目贷方数量
End If
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 24))) <> 0 Then
.Fields("TranPerson") = Trim(WglrGrid.TextMatrix(Rowjsq, 24)) '经办人
End If
.Update
End With
Next Rowjsq
'写临时凭证开始 '与 Save_VouchTemp 基本相同
'[写入临时凭证主表
If Rec_VouchMainTemp.State = 1 Then Rec_VouchMainTemp.Close
Rec_VouchMainTemp.Open "Select * From Cwzz_AccVouchMainTemp Where VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With Rec_VouchMainTemp
.Fields("Year") = Int_Year '会计年度
.Fields("Period") = Int_Period '会计期间
.Fields("Ddate") = CDate(LrText(1).Text) '制单日期
.Fields("VouchClassCode") = Trim(LrText(0).Text) '凭证类别
.Fields("Doc") = Val(LrText(2).Text) '附单据数
.Fields("Bill") = Trim(Lab_Bill.Caption) '制单人
.Fields("VouchNo") = Int(Int_VouchNo) '若已生成正式凭证应记录生成的凭证号
.Fields("SureVouchId") = int_sUreVouchId
.Update
End With
'写临时凭证辅表
Cw_DataEnvi.DataConnect.Execute "delete from Cwzz_AccVouchSubTemp where VouchId='" & Lab_VouchId & "'"
If Rec_VouchTemp.State = 1 Then Rec_VouchTemp.Close
Rec_VouchTemp.Open "Select * From Cwzz_AccVouchSubTemp Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows
If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
Exit For
End If
With Rec_VouchTemp
.AddNew
.Fields("SerialID") = Rowjsq
.Fields("VouchId") = Int(Trim(Lab_VouchId.Caption)) '凭证ID
.Fields("Digest") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) '摘要
.Fields("Ccode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) '会计科目
.Fields("Jfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) '借方金额
.Fields("Dfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))) '贷方金额
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Jfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5)) '借方数量
Else
.Fields("Dfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5)) '贷方数量
End If
'如为外币核算则原币编码为外币编码否则填充本位币编码,同时填充原币金额
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 8))) <> 0 And Trim(WglrGrid.TextMatrix(Rowjsq, 8)) <> XtSCurrCode Then
.Fields("ForeignCurrCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 8)) '外币编码
.Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, 11)) '记帐汇率
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10)) '原币借方金额
Else
.Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10)) '原币贷方金额
End If
Else
.Fields("ForeignCurrCode") = XtSCurrCode '原币编码
.Fields("AccRate") = 1 '记帐汇率
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) '原币借方金额
Else
.Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))) '原币贷方金额
End If
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) <> 0 Then
.Fields("BillDate") = CDate(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) '发生日期(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
.Fields("SScode") = Trim(WglrGrid.TextMatrix(Rowjsq, 1)) '结算方式(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 3))) <> 0 Then
.Fields("BillNo") = Trim(WglrGrid.TextMatrix(Rowjsq, 3)) '票号(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
.Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 16)) '职员编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
.Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 12)) '部门编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
.Fields("CusCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 14)) '往来客户编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 25))) <> 0 Then
.Fields("Suppliercode") = Trim(WglrGrid.TextMatrix(Rowjsq, 25)) '往来供应商编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 18))) <> 0 Then
.Fields("ItemClassCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 18)) '项目大类编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
.Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 20)) '项目编码
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("ItemJfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22)) '项目借方数量
Else
.Fields("ItemDfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22)) '项目贷方数量
End If
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 24))) <> 0 Then
.Fields("TranPerson") = Trim(WglrGrid.TextMatrix(Rowjsq, 24)) '经办人
End If
.Update
End With
Next Rowjsq
']写临时凭证结束
Lab_Succeed.Visible = True
Lab_Succeed.Caption = "已生成"
Cw_DataEnvi.DataConnect.CommitTrans
Sub_SaveBill = True
Tsxx = "凭证号:" & Trim(LrText(0).Text) & "--" & Trim(LrText(3).Text) & "保存完毕! "
Call Xtxxts(Tsxx, 0, 4)
'标识单据发生改动
Bln_BillChange = True
'设置操作状态为浏览
Lab_OperStatus = "1"
Call Sub_OperStatus("11")
Exit Function
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Lab_Succeed.Caption = ""
Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
Lrcwcl: '录入错误处理
With WglrGrid
Call Xtxxts("(第 " + Trim(Str(Int_RowCount)) + " 条会计分录)-" + Tsxx, 0, 1)
changelock = True
.Select Rowjsq, Lrywlz
WglrGrid.SetFocus
changelock = False
Exit Function
End With
End Function
Private Sub Chk_DeleteMess_Click() '删行是否提示(点击)
If Chk_DeleteMess.Value = 1 Then
Shsfts = True
Else
Shsfts = False
End If
End Sub
'选择首张,上张,下张,末张
Private Sub Sub_First() '首张
If Val(Lab_VouchId.Caption) = Min_VouchIdTemp Then 'Lab_VouchId用于标识临时凭证主表和辅表的关联Id
Exit Sub
End If
If Lab_Succeed.Caption = "" Then '首先保存该凭证到临时表中
Call Save_VouchTemp
End If
Rec_TranMainTemp.MoveFirst
Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
Call Sub_ShowBill
End Sub
Private Sub Sub_Prev() '上张
If Val(Lab_VouchId.Caption) = Min_VouchIdTemp Then
Exit Sub
End If
If Lab_Succeed.Caption = "" Then '首先保存该凭证到临时表中
Call Save_VouchTemp
End If
Rec_TranMainTemp.MovePrevious
If Rec_TranMainTemp.BOF = True Then
Rec_TranMainTemp.MoveNext
End If
Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
Call Sub_ShowBill
End Sub
Private Sub Sub_next() '下张
If Val(Lab_VouchId.Caption) = Max_VouchIdTemp Then
Exit Sub
End If
If Lab_Succeed.Caption = "" Then '首先保存该凭证到临时表中
Call Save_VouchTemp
End If
Rec_TranMainTemp.MoveNext
If Rec_TranMainTemp.EOF = True Then
Rec_TranMainTemp.MovePrevious
End If
Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
Call Sub_ShowBill
End Sub
Private Sub Sub_Last() '末张
If Val(Lab_VouchId.Caption) = Max_VouchIdTemp Then
Exit Sub
End If
If Lab_Succeed.Caption = "" Then '首先保存该凭证到临时表中
Call Save_VouchTemp
End If
Rec_TranMainTemp.MoveLast
Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
Call Sub_ShowBill
End Sub
Public Sub Sub_Scpzbb(Cxsjwg As vsFlexGrid) '生成预览凭证报表
'过程参数:输出数据网格
Dim Yxhzjsq%, Yxlzjsq% '有效列值计数器,有效行值计数器
Dim Rowjsq As Long '临时行计数器
Dim Sjhjsq As Long '数据行计数器
Dim Int_Pzmyhs As Integer '凭证每页数据行数
Dim Dbl_Jfhj As Double '借方合计
Dim Dbl_Dfhj As Double '贷方合计
'生成有效数据表
With DY_Tybbyldy.DyylGrid
.FontName = Cxsjwg.FontName
.FontSize = Cxsjwg.FontSize
.FixedRows = Cxsjwg.FixedRows
.MergeCells = flexMergeFixedOnly
For jsqte = 0 To .FixedRows - 1
.MergeRow(jsqte) = True
Next jsqte
.WordWrap = True
'重置数据列
Yxlzjsq = 4
.Cols = Yxlzjsq
.ColAlignment(2) = Cxsjwg.ColAlignment(Sydz("004", GridStr(), Szzls))
.ColAlignment(3) = Cxsjwg.ColAlignment(Sydz("005", GridStr(), Szzls))
.ColWidth(0) = Cxsjwg.ColWidth(Sydz("001", GridStr(), Szzls))
.ColWidth(1) = Cxsjwg.ColWidth(Sydz("002", GridStr(), Szzls)) + Cxsjwg.ColWidth(Sydz("003", GridStr(), Szzls))
.ColWidth(2) = Cxsjwg.ColWidth(Sydz("004", GridStr(), Szzls))
.ColWidth(3) = Cxsjwg.ColWidth(Sydz("005", GridStr(), Szzls))
.ColFormat(2) = Cxsjwg.ColFormat(Sydz("004", GridStr(), Szzls))
.ColFormat(3) = Cxsjwg.ColFormat(Sydz("005", GridStr(), Szzls))
For Yxlzjsq = 0 To 3
.MergeCol(Yxlzjsq) = True
Next Yxlzjsq
'重置数据行
Yxhzjsq = 0
For Rowjsq = 0 To Cxsjwg.Rows - 1
If (Not Cxsjwg.RowHidden(Rowjsq)) And (Not GridRowEmpty(Cxsjwg, Rowjsq)) Then
Yxhzjsq = Yxhzjsq + 1
End If
Next Rowjsq
.Rows = Yxhzjsq
.TextMatrix(0, 0) = Cxsjwg.TextMatrix(0, Sydz("001", GridStr(), Szzls))
.TextMatrix(0, 1) = "科目名称"
.TextMatrix(0, 2) = Cxsjwg.TextMatrix(0, Sydz("004", GridStr(), Szzls))
.TextMatrix(0, 3) = Cxsjwg.TextMatrix(0, Sydz("005", GridStr(), Szzls))
.RowHeight(0) = Cxsjwg.RowHeight(0)
Yxhzjsq = Cxsjwg.FixedRows
For Rowjsq = Cxsjwg.FixedRows To Cxsjwg.Rows - 1
If (Not Cxsjwg.RowHidden(Rowjsq)) And (Not GridRowEmpty(Cxsjwg, Rowjsq)) Then
'摘要
.TextMatrix(Yxhzjsq, 0) = Cxsjwg.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))
'输出科目名称
If Chk_CodeOutput.Value = 1 Then
.TextMatrix(Yxhzjsq, 1) = Cxsjwg.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) + " " + Cxsjwg.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls))
Else
.TextMatrix(Yxhzjsq, 1) = Cxsjwg.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 2)) <> "" Then '结算方式
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 2))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 3)) <> "" Then '票号
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 3))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 4)) <> "" Then '发生日期
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 4))
End If
If Val(Cxsjwg.TextMatrix(Rowjsq, 5)) <> 0 Then '数量
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 5)) + Trim(Cxsjwg.TextMatrix(Rowjsq, 7))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 9)) <> "" Then '外币名称
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 10)) + Trim(Cxsjwg.TextMatrix(Rowjsq, 9))
End If
If Val(Cxsjwg.TextMatrix(Rowjsq, 11)) <> 0 Then '记帐汇率
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + "汇率:" + Trim(Cxsjwg.TextMatrix(Rowjsq, 11))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 13)) <> "" Then '部门
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 13))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 15)) <> "" Then '往来客户
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 15))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 26)) <> "" Then '往来供应商
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 26))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 17)) <> "" Then '职员
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 17))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 19)) <> "" Then '项目大类
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 19))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 21)) <> "" Then '项目名称
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 21))
End If
If Val(Cxsjwg.TextMatrix(Rowjsq, 22)) <> 0 Then '项目数量单位
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 22)) + Trim(Cxsjwg.TextMatrix(Rowjsq, 23))
End If
If Trim(Cxsjwg.TextMatrix(Rowjsq, 24)) <> "" Then '经办人
.TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + "经办人:" + Trim(Cxsjwg.TextMatrix(Rowjsq, 24))
End If
'借方金额
.TextMatrix(Yxhzjsq, 2) = Cxsjwg.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))
'贷方金额
.TextMatrix(Yxhzjsq, 3) = Cxsjwg.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))
.RowHeight(Yxhzjsq) = Cxsjwg.RowHeight(Rowjsq)
Yxhzjsq = Yxhzjsq + 1
End If
Next Rowjsq
'补空行和添加分页合计
Int_Pzmyhs = 6
If .Rows - .FixedRows = 0 Then
Exit Sub
Else
If (.Rows - .FixedRows) Mod Int_Pzmyhs <> 0 Then
For jsqte = 1 To Int_Pzmyhs - ((.Rows - .FixedRows) Mod Int_Pzmyhs)
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
Next jsqte
End If
End If
Dbl_Jfhj = 0
Dbl_Dfhj = 0
Sjhjsq = 1
Rowjsq = .FixedRows
Do While Rowjsq <= .Rows - 1
Dbl_Jfhj = Dbl_Jfhj + Val(.TextMatrix(Rowjsq, 2))
Dbl_Dfhj = Dbl_Dfhj + Val(.TextMatrix(Rowjsq, 3))
If Sjhjsq Mod Int_Pzmyhs = 0 Then
Rowjsq = Rowjsq + 1
.AddItem "", Rowjsq
.RowHeight(Rowjsq) = Sjhgd
.TextMatrix(Rowjsq, 0) = "合计"
.TextMatrix(Rowjsq, 2) = Format(Dbl_Jfhj, "##." + String(Xtjexsws, "0"))
.TextMatrix(Rowjsq, 3) = Format(Dbl_Dfhj, "##." + String(Xtjexsws, "0"))
'最后合计输出金额大写
If Rowjsq = .Rows - 1 Then
.TextMatrix(Rowjsq, 1) = Fun_Jezh(Dbl_Jfhj)
End If
End If
Sjhjsq = Sjhjsq + 1
Rowjsq = Rowjsq + 1
Loop
End With
End Sub
Public Sub Read_Data() '从临时凭证主表中读本批临时凭证记录集
If Rec_TranMainTemp.State = 1 Then Rec_TranMainTemp.Close
SqlStr = "select * from Cwzz_AccVouchMainTemp Where OperationNo='" & Lab_OperNum.Caption & "' ORDER BY VouchId"
Set Rec_TranMainTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not Rec_TranMainTemp.EOF Then
Rec_TranMainTemp.MoveFirst
Min_VouchIdTemp = Rec_TranMainTemp.Fields("VouchId") '最小值
Rec_TranMainTemp.MoveLast
Max_VouchIdTemp = Rec_TranMainTemp.Fields("VouchId") '最大值
Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
Lab_VouchSource.Caption = Trim(Rec_TranMainTemp.Fields("VouchSource"))
End If
End Sub
Private Sub Save_VouchTemp() '写临时凭证
On Error GoTo Swcwcl
'写临时凭证，与Save_Bill中的写临时凭证程序片段相同
'写入临时凭证主表
Cw_DataEnvi.DataConnect.BeginTrans
If Rec_VouchMainTemp.State = 1 Then Rec_VouchMainTemp.Close
Rec_VouchMainTemp.Open "Select * From Cwzz_AccVouchMainTemp Where VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With Rec_VouchMainTemp
.Fields("Year") = Int_Year '会计年度
.Fields("Period") = Int_Period '会计期间
.Fields("Ddate") = CDate(LrText(1).Text) '制单日期
.Fields("VouchClassCode") = Trim(LrText(0).Text) '凭证类别
.Fields("Doc") = Val(LrText(2).Text) '附单据数
.Fields("Bill") = Trim(Lab_Bill.Caption) '制单人
'与SaveBill的不同之处是不填写"VouchNo"的值
.Update
End With
'写临时凭证辅表
Cw_DataEnvi.DataConnect.Execute "delete from Cwzz_AccVouchSubTemp where VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "'"
If Rec_VouchTemp.State = 1 Then Rec_VouchTemp.Close
Rec_VouchTemp.Open "Select * From Cwzz_AccVouchSubTemp Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows
If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
Exit For
End If
With Rec_VouchTemp
.AddNew
.Fields("SerialID") = Rowjsq
.Fields("VouchId") = Int(Trim(Lab_VouchId.Caption)) '凭证ID
.Fields("Digest") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) '摘要
If Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) = "" Then
.Fields("Ccode") = Null
Else
.Fields("Ccode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) '会计科目
End If
.Fields("Jfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) '借方金额
.Fields("Dfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))) '贷方金额
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Jfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5)) '借方数量
Else
.Fields("Dfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5)) '贷方数量
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 8))) <> 0 Then
.Fields("ForeignCurrCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 8)) '外币编码
.Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, 11)) '记帐汇率
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10)) '外币借方金额
Else
.Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10)) '外币贷方金额
End If
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) <> 0 Then
.Fields("BillDate") = CDate(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) '发生日期(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
.Fields("SScode") = Trim(WglrGrid.TextMatrix(Rowjsq, 1)) '结算方式(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 3))) <> 0 Then
.Fields("BillNo") = Trim(WglrGrid.TextMatrix(Rowjsq, 3)) '票号(银行)
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
.Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 16)) '职员编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
.Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 12)) '部门编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
.Fields("CusCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 14)) '往来客户编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 25))) <> 0 Then
.Fields("Suppliercode") = Trim(WglrGrid.TextMatrix(Rowjsq, 25)) '往来供应商编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 18))) <> 0 Then
.Fields("ItemClassCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 18)) '项目大类编码
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
.Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 20)) '项目编码
If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
.Fields("ItemJfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22)) '项目借方数量
Else
.Fields("ItemDfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22)) '项目贷方数量
End If
End If
If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 24))) <> 0 Then
.Fields("TranPerson") = Trim(WglrGrid.TextMatrix(Rowjsq, 24)) '经办人
End If
.Update
End With
Next Rowjsq
Cw_DataEnvi.DataConnect.CommitTrans
Exit Sub
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Lab_Succeed.Caption = ""
Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Private Sub Quit() '退出自动转帐程序
'判断是否有没有存盘的转帐凭证
SqlStr = "Select 1 from Cwzz_AccVouchMainTemp Where (VouchNo is Null or VouchNo=0) and OperationNo='" & Lab_OperNum.Caption & "' order by VouchId"
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If rectemp.EOF = False Then '若有
'AutoTran_NoSaveList.Show 1(区别于自动转帐,无转帐编码提示)
Tsxx = "凭证没有全部保存，退出吗？"
If Xtxxts(Tsxx, 1, 2) = 6 Then '若退出
GoTo zy
End If
Else
GoTo zy
End If
Exit Sub
zy:
Unload Me
Exit Sub
End Sub
Private Sub Sub_FillPeriTran()
'填充转帐会计日历
SqlStr = "select * from Cwzz_V_AccVouchTempCh where OperationNo='" & Lab_OperNum.Caption & "' and VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "' "
Set rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If rectemp.EOF = True Then
Exit Sub
End If
Call Sub_FillPeriod(Combo_Kjqj, rectemp.Fields("Year"), rectemp.Fields("period"))
End Sub
'**************************************************************************************'
'===================以下程序为通用部分 ,一般不需更改======================='
Private Sub Sub_AdjustGrid()
'调整网格
With WglrGrid
'加 1 保持一行录入行
If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
.Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
For jsqte = .FixedRows To .Rows - 1
.RowHeight(jsqte) = Sjhgd
Next jsqte
Else
'判断是否有辅助行和录入行,如没有则加行
Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
Loop
End If
End With
End Sub
Private Sub Lrzdbz() '录入字段帮助
If Not Ydcommand.Visible Then
Exit Sub
End If
Valilock = True
With WglrGrid
'[>>会计科目编码帮助单独处理
If .Col = Sydz("002", GridStr(), Szzls) Then
Xtcdcs = Trim(Ydtext.Text)
PZ_FrmKjkmcz.Show 1
If Len(Xtfhcs) <> 0 Then
Ydtext.Text = Xtfhcs
End If
Else
'处理通用部分
changelock = True '调入另外窗体必须加锁
Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
changelock = False
If Len(Xtfhcs) <> 0 Then
If GridInt(.Col, 7) = 0 Then
Ydtext.Text = Xtfhcs
Else
Ydtext.Text = Xtfhcsfz
End If
End If
End If
'[>>处理完毕
Valilock = False
If Ydtext.Visible Then
Ydtext.SetFocus
End If
End With
End Sub
Private Sub Cshhjwg() '初始化合计网格(*对合计网格来说,录入网格为容器)
Dim Lrwglkd As Double
Dim Hjwgpyl As Integer
With HjGrid
If Not Sfxshjwg Then
.Visible = False
Exit Sub
Else
.Visible = True
End If
.Enabled = False
.Appearance = flexFlat
.BorderStyle = flexBorderNone
.ScrollBars = flexScrollBarNone
.Width = WglrGrid.Width
.FixedRows = 0
.Rows = 1
.Cols = WglrGrid.Cols
.LeftCol = WglrGrid.LeftCol
.TextMatrix(0, Qslz) = "合计"
For jsqte = 0 To WglrGrid.Cols - 1
.ColHidden(jsqte) = WglrGrid.ColHidden(jsqte)
.ColWidth(jsqte) = WglrGrid.ColWidth(jsqte)
.ColAlignment(jsqte) = WglrGrid.ColAlignment(jsqte)
.ColFormat(jsqte) = WglrGrid.ColFormat(jsqte)
Next jsqte
.ColAlignment(Qslz) = flexAlignCenterTop
For jsqte = .FixedRows To .Rows - 1
.RowHeight(jsqte) = .Height / .Rows
Next jsqte
.Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
End With
End Sub
Private Sub Form_Resize() '窗体大小发生变化时,重新显示文本框
Call Cxxswbk
End Sub
Private Function Fun_Drfrmyxxpd() As Boolean '调入其它窗体或功能产生的有效性判断(包括数据回写)
Fun_Drfrmyxxpd = True
With WglrGrid
'如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
If Ydtext.Visible Or YdCombo.Visible Then
Call Lrsjhx
If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
Fun_Drfrmyxxpd = False
Exit Function
End If
End If
'进行行有效性判断
If Not Sjhzyxxpd(.Row) Then
Fun_Drfrmyxxpd = False
Exit Function
End If
End With
End Function
Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long) '调整列宽
If HjGrid.Visible Then
With HjGrid
.ColWidth(Col) = WglrGrid.ColWidth(Col)
End With
End If
End Sub
Private Sub WglrGrid_EnterCell() '显示当前数据行相关信息
With WglrGrid
If .Row >= .FixedRows Then
Lab_Row = Trim(Str(.Row - .FixedRows + 1))
'显示备注信息
Call Sub_ShowMemo(WglrGrid.Row)
End If
End With
End Sub
Private Sub WglrGrid_GotFocus() '网格得到焦点
'网格得到焦点,如果当前选择行为非数据行
'则调整当前焦点至有效数据行
With WglrGrid
If .Row < .FixedRows And .Rows > .FixedRows Then
changelock = True
.Select .FixedRows, .Col
changelock = False
End If
If .Col < Qslz Then
changelock = True
.Select .Row, Qslz
changelock = False
End If
End With
End Sub
Private Sub WglrGrid_LostFocus() '录入网格失去焦点
'用以屏蔽调用其它窗体时发生网格失去焦点事件
If changelock Then
Exit Sub
End If
'引发网格RowcolChange事件
With WglrGrid
If Not (Ydtext.Visible Or YdCombo.Visible) Then
.Select 0, 0
End If
End With
End Sub
Private Sub WglrGrid_Scroll() '限制用户在录入过程中滚动鼠标
If Gdtlock Then
Exit Sub
End If
With WglrGrid
If Ydtext.Visible Or YdCombo.Visible Then
Gdtlock = True
.TopRow = Dqtoprow
.LeftCol = Dqleftcol
Gdtlock = False
Exit Sub
End If
HjGrid.LeftCol = .LeftCol
End With
End Sub
Private Sub WglrGrid_LeaveCell() '离开单元格
If changelock Then
Exit Sub
End If
'记录刚刚离开网格单元的行列值
Dqlkwgh = WglrGrid.Row
Dqlkwgl = WglrGrid.Col
'判断是否需要录入数据回写
If Not (Ydtext.Visible Or YdCombo.Visible) Then
Exit Sub
End If
Call Lrsjhx
End Sub
Private Sub WglrGrid_RowColChange() '网格录入行列发生变化时,进行有效性判断
Valilock = True '屏蔽文本框失去焦点进行有效性判断
With WglrGrid
If changelock Then
Exit Sub
End If
If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
Exit Sub
End If
If .Row <> Dqlkwgh Then
If Not Sjhzyxxpd(Dqlkwgh) Then
Exit Sub
End If
End If
End With
Call fhyxh
Call Xldql
End Sub
Private Sub WglrGrid_DblClick() '鼠标双击网格显示文本框
With WglrGrid
Call xswbk
End With
End Sub
Private Sub Ycwbk() '隐藏文本框,帮助按钮,列表组合框
Valilock = True
Ydtext.Visible = False
YdCombo.Visible = False
Ydcommand.Visible = False
End Sub
Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer) '列表框移动
With WglrGrid
Select Case KeyCode
Case vbKeyEscape 'ESC 键放弃录入
Valilock = True
.SetFocus
Call Ycwbk
Valilock = False
Case vbKeyReturn '回车键 =13
KeyCode = 0
.SetFocus
Call Lrsjhx
Rowjsq = .Row
Coljsq = .Col + 1
If Coljsq > .Cols - 1 Then
If Rowjsq < .Rows - 1 Then
Rowjsq = Rowjsq + 1
End If
Coljsq = Qslz
End If
Do While Rowjsq <= .Rows - 1
If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
Coljsq = Coljsq + 1
If Coljsq > .Cols - 1 Then
Rowjsq = Rowjsq + 1
Coljsq = Qslz
End If
Else
Exit Do
End If
Loop
.Select Rowjsq, Coljsq
Case vbKeyLeft '左箭头 =37
If .Col - 1 = Qslz Then
If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
GoTo jzzx
End If
End If
If .Col > Qslz Then
KeyCode = 0
.SetFocus
Call Lrsjhx
Coljsq = .Col - 1
Do While Coljsq > Qslz
If Coljsq - 1 = Qslz Then
If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
GoTo jzzx
End If
End If
If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
Coljsq = Coljsq - 1
Else
Exit Do
End If
Loop
.Select .Row, Coljsq
End If
Case vbKeyRight '右箭头 =39
KeyCode = 0
.SetFocus
Call Lrsjhx
Rowjsq = .Row
Coljsq = .Col + 1
If Coljsq > .Cols - 1 Then
If Rowjsq < .Rows - 1 Then
Rowjsq = Rowjsq + 1
End If
Coljsq = Qslz
End If
Do While Rowjsq <= .Rows - 1
If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
Coljsq = Coljsq + 1
If Coljsq > .Cols - 1 Then
Rowjsq = Rowjsq + 1
Coljsq = Qslz
End If
Else
Exit Do
End If
Loop
.Select Rowjsq, Coljsq
Case Else
End Select
jzzx:
End With
End Sub
Private Sub YdCombo_LostFocus()
With WglrGrid '因为选中网格会先发生Rowcolchange事件置Valiock
If Not Valilock Then '为TRUE
Call Lrsjhx
If Not Sjhzyxxpd(Dqlrwgh) Then
Exit Sub
End If
End If
End With
End Sub
Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Lrzdbz
End Sub
Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Rowjsq As Long, Coljsq As Long
With WglrGrid
Select Case KeyCode
Case vbKeyF2
Call Lrzdbz
Case vbKeyEscape 'ESC 键放弃录入
Valilock = True
Call Ycwbk
.SetFocus
Case vbKeyReturn '回车键 =13
KeyCode = 0
.SetFocus
Call Lrsjhx
Rowjsq = .Row
Coljsq = .Col + 1
If Coljsq > .Cols - 1 Then
If Rowjsq < .Rows - 1 Then
Rowjsq = Rowjsq + 1
End If
Coljsq = Qslz
End If
Do While Rowjsq <= .Rows - 1
If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
Coljsq = Coljsq + 1
If Coljsq > .Cols - 1 Then
Rowjsq = Rowjsq + 1
Coljsq = Qslz
End If
Else
Exit Do
End If
Loop
.Select Rowjsq, Coljsq
Case vbKeyUp '上箭头 =38
KeyCode = 0
.SetFocus
Call Lrsjhx
If .Row > .FixedRows Then
.Row = .Row - 1
End If
Case vbKeyDown '下箭头 =40
KeyCode = 0
.SetFocus
Call Lrsjhx
If .Row < .Rows - 1 Then
.Row = .Row + 1
End If
Case vbKeyLeft '左箭头 =37
If .Col - 1 = Qslz Then
If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
GoTo jzzx
End If
End If
If Ydtext.SelStart = 0 And .Col > Qslz Then
KeyCode = 0
.SetFocus
Call Lrsjhx
Coljsq = .Col - 1
Do While Coljsq > Qslz
If Coljsq - 1 = Qslz Then
If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
GoTo jzzx
End If
End If
If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
Coljsq = Coljsq - 1
Else
Exit Do
End If
Loop
.Select .Row, Coljsq
End If
jzzx:
Case vbKeyRight '右箭头 =39
wblong = Len(Ydtext.Text)
If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
KeyCode = 0
.SetFocus
Call Lrsjhx
Rowjsq = .Row
Coljsq = .Col + 1
If Coljsq > .Cols - 1 Then
If Rowjsq < .Rows - 1 Then
Rowjsq = Rowjsq + 1
End If
Coljsq = Qslz
End If
Do While Rowjsq <= .Rows - 1
If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
Coljsq = Coljsq + 1
If Coljsq > .Cols - 1 Then
Rowjsq = Rowjsq + 1
Coljsq = Qslz
End If
Else
Exit Do
End If
Loop
.Select Rowjsq, Coljsq
End If
Case Else
End Select
End With
End Sub
Private Sub ydtext_KeyPress(KeyAscii As Integer) '录入字符事中控制
Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
If KeyAscii <> 0 Then
Call Xyxhbz(Dqlrwgh)
End If
End Sub
Private Sub ydtext_Change() '录入事中变化处理
'防止程序改变但不进行处理
If Wbkbhlock Then
Exit Sub
End If
With WglrGrid
'限制字段录入长度
Wbkbhlock = True
Select Case GridInt(.Col, 1)
Case 8
Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
Case 9
Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
Case 10
Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
Case Else
If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
End If
End Select
Wbkbhlock = False
End With
End Sub
Private Sub ydtext_LostFocus() '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
With WglrGrid
If Not Valilock Then
Call Lrsjhx
If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
Exit Sub
End If
If Not Sjhzyxxpd(Dqlrwgh) Then
Exit Sub
End If
End If
End With
End Sub
Private Sub xswbk() '在当前选中单元显示文本框,列表框,帮助按钮(通用)
Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
'如果单据操作状态为浏览状态则不能显示录入载体
If Trim(Lab_OperStatus.Caption) = "1" Then
Exit Sub
End If
'显示文本框前返回有效行列（解决滚动条问题）
Call Xldqh
Call Xldql
'隐藏文本框,帮助按钮,列表组合框
Call Ycwbk
With WglrGrid
Dqlrwgh = .Row
Dqlrwgl = .Col
If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
Exit Sub
End If
Wbkpy = 30
Wbkpy1 = 15
If GridBoolean(.Col, 3) Then
YdCombo.Left = .CellLeft + .Left + Wbkpy
YdCombo.Top = .CellTop + .Top + Wbkpy
YdCombo.Width = .CellWidth - Wbkpy1
Call Wbkcl
YdCombo.Visible = True
YdCombo.SetFocus
Ydcommand.Visible = False
Ydtext.Visible = False
Else
If GridBoolean(.Col, 2) Then
Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
Ydcommand.Visible = True
Else
Ydcommand.Visible = False
End If
Ydtext.Left = .CellLeft + .Left + Wbkpy
Ydtext.Top = .CellTop + .Top + Wbkpy
If Ydcommand.Visible Then
If Sfblbzkd Then
Ydtext.Width = .CellWidth - Ydcommand.Width
Else
Ydtext.Width = .CellWidth - Wbkpy1
End If
Else
Ydtext.Width = .CellWidth - Wbkpy1
End If
Ydtext.Height = .CellHeight - Wbkpy1
If GridInt(.Col, 2) <> 0 Then
Ydtext.MaxLength = GridInt(.Col, 2)
Else
Ydtext.MaxLength = 3000
End If
Call Wbkcl
Ydtext.Visible = True
Ydtext.SetFocus
End If
Dqtoprow = .TopRow
Dqleftcol = .LeftCol
'重置锁值
Valilock = False
Wbkbhlock = False
End With
End Sub
Private Sub Cxxswbk() 'Formresize中重新显示文本框,列表框,帮助按钮(通用)
Dim Wbkpy As Integer, Wbkpy1 As Integer
Wbkpy = 30
Wbkpy1 = 15
With WglrGrid
If YdCombo.Visible Then
YdCombo.Left = .CellLeft + .Left + Wbkpy
YdCombo.Top = .CellTop + .Top + Wbkpy
YdCombo.Width = .CellWidth - Wbkpy1
End If
If Ydcommand.Visible Then
Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
End If
If Ydtext.Visible Then
If Ydcommand.Visible Then
If Sfblbzkd Then
Ydtext.Width = .CellWidth - Ydcommand.Width
Else
Ydtext.Width = .CellWidth - Wbkpy1
End If
Else
Ydtext.Width = .CellWidth - Wbkpy1
End If
Ydtext.Left = .CellLeft + .Left + Wbkpy
Ydtext.Top = .CellTop + .Top + Wbkpy
Ydtext.Height = .CellHeight - Wbkpy1
End If
End With
End Sub
Private Sub Lrsjhx() '文本框录入数据回写
With WglrGrid
If YdCombo.Visible Then
.Text = Trim(YdCombo.Text)
End If
If Ydtext.Visible Then
.Text = Trim(Ydtext.Text)
End If
'(如果字段录入内容发生变化,则打开有效性判断锁)
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 Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer) '网格录入增行，删行快捷键
'如果单据操作状态为浏览状态则不能显示录入载体
If Trim(Lab_OperStatus.Caption) = "1" Then
Exit Sub
End If
Select Case KeyCode
Case vbKeyDelete '删行
Call Scdqfl
Case vbKeyInsert '增行
Call zjlrfl
End Select
End Sub
Private Sub WglrGrid_KeyPress(KeyAscii As Integer) '网格接受键盘录入
Dim Str_ChangeTe As String '临时交换内容
Dim Coljsq As Long '临时列计数器
Dim Int_SaveKey As Integer '保存KeyAscii值
'如果单据操作状态为浏览状态则不能显示录入载体
If Trim(Lab_OperStatus.Caption) = "1" Then
Exit Sub
End If
Int_SaveKey = KeyAscii
With WglrGrid
'屏蔽回车键
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
Rowjsq = .Row
Coljsq = .Col + 1
If Coljsq > .Cols - 1 Then
If Rowjsq < .Rows - 1 Then
Rowjsq = Rowjsq + 1
End If
Coljsq = Qslz
End If
Do While Rowjsq <= .Rows - 1
If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
Coljsq = Coljsq + 1
If Coljsq > .Cols - 1 Then
Rowjsq = Rowjsq + 1
Coljsq = Qslz
End If
Else
Exit Do
End If
Loop
.Select Rowjsq, Coljsq
Exit Sub
End If
'接受用户录入
Select Case KeyAscii
Case 0 To 32
'[>>开始当用户输入空格时,如果在摘要列则自动填入上条记录录入的摘要内容
' 如果在金额列则交换借贷内容,此段程序不要求有效性判断,否则应另行处理
Select Case GridStr(.Col, 1)
Case "001" '摘要
If Len(Trim(WglrGrid.TextMatrix(.Row, .Col))) = 0 And Len(Trim(Str_Digest)) <> 0 Then
WglrGrid.TextMatrix(.Row, .Col) = Str_Digest
'写有效行数据标志,并打开行有效性判断锁
Call Xyxhbz(.Row)
Hyxxpdlock = False
End If
Case "004", "005" '借方金额,贷方金额
If Val(WglrGrid.TextMatrix(.Row, .Col)) = 0 Then
Str_ChangeTe = WglrGrid.TextMatrix(.Row, Sydz("004", GridStr(), Szzls))
WglrGrid.TextMatrix(.Row, Sydz("004", GridStr(), Szzls)) = WglrGrid.TextMatrix(.Row, Sydz("005", GridStr(), Szzls))
WglrGrid.TextMatrix(.Row, Sydz("005", GridStr(), Szzls)) = Str_ChangeTe
'写有效行数据标志,并打开行有效性判断锁
Call Xyxhbz(.Row)
Hyxxpdlock = False
'计算合计数据
For Coljsq = Qslz To .Cols - 1
Call Sjhj(Coljsq)
Next Coljsq
End If
End Select
'完毕<<]
'显示录入载体
Call xswbk
Case Else
'防止非编辑字段SendKeys()出现死循环
If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
Exit Sub
End If
If GridBoolean(.Col, 3) Then
'列表框录入
Call xswbk
Else
'[>>开始如果用户在借贷金额位置按"="且当前行金额为零则自动计算借贷合计差额填入录入文本框
If Chr(KeyAscii) = "=" And (Val(.TextMatrix(.Row, Sydz("004", GridStr(), Szzls))) = 0 And Val(.TextMatrix(.Row, Sydz("005", GridStr(), Szzls))) = 0) Then
Select Case GridStr(.Col, 1)
Case "004" '借方金额
Ydtext.Text = ""
Call Xyxhbz(.Row)
Call xswbk
Ydtext.Text = Format(Val(HjGrid.TextMatrix(0, Sydz("005", GridStr(), Szzls))) - Val(HjGrid.TextMatrix(0, .Col)), "##." + String(Xtjexsws, "0"))
Case "005" '贷方金额
Ydtext.Text = ""
Call Xyxhbz(.Row)
Call xswbk
Ydtext.Text = Format(Val(HjGrid.TextMatrix(0, Sydz("004", GridStr(), Szzls))) - Val(HjGrid.TextMatrix(0, .Col)), "##." + String(Xtjexsws, "0"))
End Select
'完毕<<]
Else
Ydtext.Text = ""
Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
If KeyAscii = 0 Then
Exit Sub
End If
'写有效行数据标志
Call Xyxhbz(.Row)
Call xswbk
Ydtext.Text = ""
Valilock = True
SendKeys Chr(KeyAscii), wait
DoEvents
Valilock = False
End If
End If
End Select
End With
End Sub
Private Sub zjlrfl() '增加录入分录
'判断当前凭证是否允许修改
With WglrGrid
If Not (Ydtext.Visible Or YdCombo.Visible) Then
If Not Fun_Drfrmyxxpd Then
Exit Sub
End If
Else
Exit Sub
End If
If .Row < .FixedRows Then
Exit Sub
End If
.AddItem "", .Row
.RowHeight(.Row) = Sjhgd
If .Row <> .Rows - 1 Then
If .TextMatrix(.Row + 1, 0) = "*" Then
.TextMatrix(.Row, 0) = "*"
Else
.RemoveItem .Rows - 1
End If
End If
Call Xldqh
Call Xldql
Hyxxpdlock = False
End With
End Sub
Private Sub Scdqfl() '删除当前分录
'判断当前凭证是否允许修改
Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
With WglrGrid
Scqwghz = .Row
Scqwglz = .Col
If .TextMatrix(.Row, 0) = "*" Then
'判断是否为录入状态
If Ydtext.Visible Or YdCombo.Visible Then
Sflrzt = True
Validate = True
Call Lrsjhx
Validate = False
End If
Call Xldqh
changelock = True
.Select .Row, 0
changelock = False
If Shsfts Then
.Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
Tsxx = "请确认是否删除当前记录?"
yhAnswer = Xtxxts(Tsxx, 2, 2)
If yhAnswer = 2 Then
.Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
changelock = True
.Select Scqwghz, Scqwglz
changelock = False
'如为录入状态,则恢复录入
If Sflrzt Then
Call xswbk
End If
Exit Sub
End If
End If
.RemoveItem .Row
If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
End If
changelock = True
.Select .Row, Scqwglz
changelock = False
'重新计算合计数据
For Hjlzte = Qslz To .Cols - 1
Call Sjhj(Hjlzte)
Next Hjlzte
End If
End With
End Sub
Private Sub Sjhj(Hjwgl As Long) '网格列数据合计
Dim Hjjg As Double
If Not (GridBoolean(Hjwgl, 4) And HjGrid.Visible) Then
Exit Sub
End If
With WglrGrid
Hjjg = 0
For jsqte = .FixedRows To .Rows - 1
If .TextMatrix(jsqte, 0) = "*" Then
Hjjg = Hjjg + Val(.TextMatrix(jsqte, Hjwgl))
End If
Next jsqte
If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
HjGrid.TextMatrix(0, Hjwgl) = ""
Else
HjGrid.TextMatrix(0, Hjwgl) = Hjjg
End If
End With
End Sub
Private Sub Qkwlzd(sjh As Long, Sjl As Long) '清空为零字段
If Not GridBoolean(Sjl, 5) Then
Exit Sub
End If
With WglrGrid
If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
.TextMatrix(sjh, Sjl) = ""
End If
End With
End Sub
Private Sub fhyxh() '返回录入数据有效行,同时让得到焦点网格可见
With WglrGrid
If .Row >= .FixedRows Then
If .TextMatrix(.Row, 0) <> "*" Then
For Rowjsq = .FixedRows To .Rows - 1
If .TextMatrix(Rowjsq, 0) <> "*" Then
Exit For
End If
Next Rowjsq
If Rowjsq <= .Rows - 1 Then
changelock = True
.Select Rowjsq, .Col
changelock = False
Else
changelock = True
.Select .Rows - 1, .Col
changelock = False
End If
End If
Call Xldqh
End If
End With
End Sub
Private Sub Xldqh() '显露当前行
Dim Toprowte As Long
With WglrGrid
Toprowte = 0
Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
Toprowte = .TopRow
.TopRow = .TopRow + 1
Loop
Toprowte = 0
Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
Toprowte = .TopRow
.TopRow = .TopRow - 1
Loop
End With
End Sub
Private Sub Xldql() '显露当前列
Dim Leftcolte As Long
With WglrGrid
If .Col >= Qslz Then
If .LeftCol > .Col Then
.LeftCol = .Col
End If
Leftcolte = 0
Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
Leftcolte = .LeftCol
.LeftCol = .LeftCol + 1
Loop
End If
End With
End Sub
Private Function pdhwk(sjh As Long) '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
With WglrGrid
For Coljsq = Qslz To .Cols - 1
If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
pdhwk = False
Exit Function
End If
Next Coljsq
pdhwk = True
End With
End Function
Private Sub Xyxhbz(sjh As Long) '写行有效性标志,并判断是否增行
With WglrGrid
If .TextMatrix(sjh, 0) = "*" Then
Exit Sub
End If
.TextMatrix(sjh, 0) = "*"
If sjh >= .Rows - Fzxwghs - 1 Then
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
End If
End With
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '表格格式设置(通用)
Select Case Button.Key
Case "bcgs" '保存表格格式
Call Bcwggs(WglrGrid, GridCode, GridStr)
Case "hfmrgs" '恢复默认格式
Call Hfmrgs(WglrGrid, 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 = 1 '报表表尾行数
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
Bbxbt(1) = Space(45) + Fun_FormatOutPut("制单日期:" + Trim(LrText(1).Text), 30)
Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("凭证字号:" + Trim(LrText(0).Text) + "-" + Trim(LrText(3).Text), 26)
Bbbwh(1) = Fun_FormatOutPut("会计主管:", 18) + Fun_FormatOutPut("记帐:" + Lab_Book, 18)
Bbbwh(1) = Bbbwh(1) + Fun_FormatOutPut("出纳:", 18) + Fun_FormatOutPut("审核:" + Lab_Checker, 18)
Bbbwh(1) = Bbbwh(1) + Fun_FormatOutPut("制单:" + Lab_Bill, 18) + Trim(Fun_FormatOutPut("附单据数:" + Trim(LrText(2).Text), 23))
bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
Bbbwhzzxs(1) = 1
Call Sub_Scpzbb(WglrGrid) '生成报表数据(自定义程序)
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 LrText_Change(Index As Integer)
'屏蔽程序改变控制
If TextChangeLock Then
Exit Sub
End If
TextValiJudgeLock(Index) = False '打开有效性判断锁
'限制字段录入长度
TextChangeLock = True '加锁(防止执行Lrtext_Change)
Select Case Textint(Index, 1)
Case 8 '金额型
Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
Case 9 '数量型
Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
Case 10 '单价型
Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
Case Else '其他小数类型控制
If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
End If
End Select
'[>>随时计算最新单据号
If Index = 0 Then
Call Sub_JsVouchNo
End If
'<<]
TextChangeLock = False '解锁
End Sub
Private Sub LrText_GotFocus(Index As Integer) '文本框得到焦点,显示相应信息
Call TextShow(Index)
End Sub
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) '字段按F2键提供帮助
Select Case KeyCode
Case vbKeyF2
Call Text_Help(Index)
End Select
End Sub
Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer) '文本框录入事中控制
Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub
Private Sub LrText_LostFocus(Index As Integer) '文本框失去焦点进行有效性判断及相应处理
If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
Call TextYxxpd(Index)
End If
End Sub
Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Text_Help(Ydcommand1.Tag)
End Sub
Private Sub Text_Help(Index As Integer) '录入字段帮助
If Not Ydcommand1.Visible Then
Exit Sub
End If
TextValiLock = True
Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
If Len(Xtfhcs) <> 0 Then
If Textint(Index, 3) = 1 Then
LrText(Index).Text = Xtfhcsfz
LrText(Index).Tag = Xtfhcs
Else
LrText(Index).Text = Xtfhcs
LrText(Index).Tag = Xtfhcsfz
End If
End If
TextValiLock = False
' LrText(Index).SetFocus
End Sub
Private Sub TextShow(Index As Integer) '文本框得到焦点,显示相应信息
If Textboolean(Index, 1) Then
Ydcommand1.Visible = True
Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
Ydcommand1.Tag = Index
Else
Ydcommand1.Tag = ""
Ydcommand1.Visible = False
End If
End Sub
Private Sub Wbkcsh() '录入文本框初始化
'最大录入文本框索引值
Max_Text_Index = Textvar(1)
ReDim TextValiJudgeLock(Max_Text_Index)
For jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
TextChangeLock = True
LrText(jsqte).Text = ""
LrText(jsqte).Tag = ""
If Textint(jsqte, 5) <> 0 Then
LrText(jsqte).MaxLength = Textint(jsqte, 5)
End If
TextChangeLock = False
End If
TextValiJudgeLock(jsqte) = True
Next jsqte
End Sub
Private Function TextYxxpd(Index As Integer) As Boolean '文本框有效性判断
Dim SqlStr As String
Dim Findrec As New ADODB.Recordset
'按帮助不进行有效性判断
If TextValiLock Then
TextValiLock = False
TextYxxpd = True
Exit Function
End If
'文本框内容未曾改变不进行有效性判断
If TextValiJudgeLock(Index) Then
Ydcommand1.Visible = False
TextYxxpd = True
Exit Function
End If
If Trim(LrText(Index)) = "" Then
LrText(Index).Tag = ""
Call Wbklrwbcl(Index)
Ydcommand1.Visible = False
TextValiJudgeLock(Index) = True
TextYxxpd = True
'[>>如果凭证类别清空，则字号应清空
If Index = 0 Then
TextChangeLock = True
LrText(3).Text = ""
TextChangeLock = False
End If
'<<]
Exit Function
End If
Select Case Textint(Index, 4)
Case 1 '编码型
SqlStr = Trim(Textstr(Index, 5))
SqlStr = Replace(SqlStr, "@", "'" + Trim(LrText(Index).Text) + "'")
Set Findrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Findrec.EOF Then
Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
LrText(Index).SetFocus
Exit Function
Else
Select Case Textint(Index, 3)
Case 0
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
Case 1
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
End Select
End If
'[>>凭证类别如有效,且内容已经发生改变则自动计算类别字号
If Index = 0 Then
Call Sub_JsVouchNo
End If
'<<]
Case 2 '日期型
If IsDate(LrText(Index).Text) Then
LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
Else
Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
Call Xtxxts(Tsxx, 0, 1)
LrText(Index).SetFocus
Exit Function
End If
Case 3 '其他类型
End Select
Ydcommand1.Visible = False
TextValiJudgeLock(Index) = True
TextYxxpd = True
End Function