上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:187k
源码类别:

企业管理

开发平台:

Visual Basic

  1.                                 '判断外币折算方式
  2.                                 If RecTemp.Fields("ConVertFlag") Then
  3.                                     WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) / Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
  4.                                 Else
  5.                                     WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) * Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
  6.                                 End If
  7.                             Else
  8.                                 
  9.                                 '判断外币折算方式
  10.                                 If RecTemp.Fields("ConVertFlag") Then
  11.                                     WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) / Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
  12.                                 Else
  13.                                     WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) * Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
  14.                                 End If
  15.                             End If
  16.                         End If
  17.                         
  18.                         Exit For
  19.                     End If
  20.                 Next jsqte
  21.             End If
  22.         End With
  23.         
  24.         '计算合计数据
  25.         For Coljsq = Qslz To WglrGrid.Cols - 1
  26.             Call Sjhj(Coljsq)
  27.         Next Coljsq
  28.         
  29.         '重新显示辅助核算信息
  30.         Call Sub_ShowMemo(WglrGrid.Row)
  31.         
  32.     End If
  33. End Sub
  34. Private Sub Kmfzhsx(Lng_GridRow As Long)                  '调用科目辅助核算项
  35.     '过程函数;Lng_gridrow当前网格调入辅助核算行
  36.     Dim Kjqstop#, Kjqsleft#, Kjjg#, Ctzxgd#, Kjxsgs%, jsqte%
  37.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  38.     Kjqstop = 300          '控件显示起始高度
  39.     Kjqsleft = 300         '控件显示起始左边界
  40.     Kjjg = 450             '控件显示间隔
  41.     Kjxsgs = 0             '控件显示个数
  42.     Ctzxgd = 1500          '窗体显示最小高度
  43.     With AutoTran_PzAss          '辅助核算项目窗体
  44.         .Caption = "辅助核算项目_" + Trim(WglrGrid.TextMatrix(Lng_GridRow, Sydz("003", GridStr(), Szzls)))
  45.         For jsqte = 0 To Int_AssCount - 1
  46.             If Bln_AssShow(jsqte) Then
  47.                 .TsLabel(jsqte).Visible = True
  48.                 .TsLabel(jsqte).Move Kjqsleft, Kjqstop + Kjxsgs * Kjjg
  49.                 .LrText(jsqte).Visible = True
  50.                 .LrText(jsqte).Move .TsLabel(jsqte).Left + .TsLabel(jsqte).Width + 50, .TsLabel(jsqte).Top - 100
  51.                 If Bln_AssHelp(jsqte) Then
  52.                     .Ydcommand1(jsqte).Visible = True
  53.                     .Ydcommand1(jsqte).Move .LrText(jsqte).Left + .LrText(jsqte).Width, .LrText(jsqte).Top, .Ydcommand1(jsqte).Width, .LrText(jsqte).Height
  54.                 End If
  55.                 Kjxsgs = Kjxsgs + 1
  56.                 Select Case jsqte
  57.                 Case 0     '结算方式
  58.                     .LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 1))
  59.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 2))
  60.                 Case 1     '票号
  61.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 3))
  62.                 Case 2     '发生日期
  63.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 4))
  64.                 Case 3     '数量
  65.                     .LrText(jsqte).Text = WglrGrid.TextMatrix(Lng_GridRow, 5)
  66.                     .Lab_Measure = Trim(WglrGrid.TextMatrix(Lng_GridRow, 7))
  67.                     .Lab_Measure.Move .LrText(jsqte).Left + .LrText(jsqte).Width + 50, .LrText(jsqte).Top + 100
  68.                 Case 4     '单价
  69.                     If Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) <> 0 And Val(WglrGrid.TextMatrix(Lng_GridRow, 5)) <> 0 Then
  70.                         .LrText(jsqte).Text = Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) / Val(WglrGrid.TextMatrix(Lng_GridRow, 5))
  71.                     Else
  72.                         If Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) <> 0 And Val(WglrGrid.TextMatrix(Lng_GridRow, 5)) <> 0 Then
  73.                             .LrText(jsqte).Text = Val(WglrGrid.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) / Val(WglrGrid.TextMatrix(Lng_GridRow, 5))
  74.                         End If
  75.                     End If
  76.                 Case 5     '外币金额
  77.                     .LrText(jsqte).Text = WglrGrid.TextMatrix(Lng_GridRow, 10)
  78.                     .Lab_ForeignName.Caption = "(" + Trim(WglrGrid.TextMatrix(Lng_GridRow, 9)) + ")"
  79.                     .Lab_ForeignName.Move .LrText(jsqte).Left + .LrText(jsqte).Width + 50, .LrText(jsqte).Top + 100
  80.                 Case 6     '汇率
  81.                     .LrText(jsqte).Text = WglrGrid.TextMatrix(Lng_GridRow, 11)
  82.                 Case 7     '部门
  83.                     .LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 12))
  84.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 13))
  85.                 Case 8     '客户
  86.                     .LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 14))
  87.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 15))
  88.                 Case 9     '个人
  89.                     .LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 16))
  90.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 17))
  91.                 Case 10     '项目
  92.                     .Lab_ItemClass.Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 18))
  93.                     .Lab_ItemClass.Caption = "(" + Trim(WglrGrid.TextMatrix(Lng_GridRow, 19)) + ")"
  94.                     .Lab_ItemClass.Move .LrText(jsqte).Left + .LrText(jsqte).Width + 400, .LrText(jsqte).Top + 100
  95.                     .LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 20))
  96.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 21))
  97.                     Sqlstr = "select * from Cwzz_item where ItemClassCode='" & .Lab_ItemClass.Tag & "' and ItemCode='" & Trim(.LrText(10).Tag) & "'"
  98.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  99.                     If Not RecTemp.EOF Then
  100.                         If RecTemp.Fields("QuantityFlag") Then
  101.                             .LrText(11).Text = WglrGrid.TextMatrix(Lng_GridRow, 22)
  102.                             .Lab_ItemMeasure = Trim(RecTemp.Fields("Measure"))
  103.                         End If
  104.                     End If
  105.                 Case 11
  106.                     .Lab_ItemMeasure.Move .LrText(11).Left + .LrText(11).Width + 50, .LrText(11).Top + 50
  107.                 Case 12      '供应商
  108.                     .LrText(jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 25))
  109.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 26))
  110.                 Case 13      '经办人
  111.                     .LrText(jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 24))
  112.                 End Select
  113.             Else
  114.                 .TsLabel(jsqte).Visible = False
  115.                 .LrText(jsqte).Visible = False
  116.                 If Bln_AssHelp(jsqte) Then
  117.                     .Ydcommand1(jsqte).Visible = False
  118.                 End If
  119.             End If
  120.         Next jsqte
  121.         If Kjqstop * 3 + Kjxsgs * Kjjg > Ctzxgd Then
  122.             .Height = Kjqstop * 3 + Kjxsgs * Kjjg
  123.         Else
  124.             .Height = Ctzxgd
  125.         End If
  126.         
  127.         '加锁
  128.         changelock = True
  129.         .Show 1
  130.         changelock = False
  131.     End With
  132. End Sub
  133. Private Sub Sub_ShowMemo(Lng_GridRow)                                    '显示网格备注项
  134.     '函数参数:网格行
  135.     
  136.     Dim Str_Memo As String
  137.     Str_Memo = ""
  138.     With WglrGrid
  139.         If Len(Trim(.TextMatrix(Lng_GridRow, 2))) <> 0 Then
  140.             Str_Memo = Str_Memo + "结算方式:" + Trim(.TextMatrix(Lng_GridRow, 2)) + Space(2)
  141.         End If
  142.         If Len(Trim(.TextMatrix(Lng_GridRow, 3))) <> 0 Then
  143.             Str_Memo = Str_Memo + "票号:" + Trim(.TextMatrix(Lng_GridRow, 3)) + Space(2)
  144.         End If
  145.         If Len(Trim(.TextMatrix(Lng_GridRow, 4))) <> 0 Then
  146.             Str_Memo = Str_Memo + "发生日期:" + Trim(.TextMatrix(Lng_GridRow, 4)) + Space(2)
  147.         End If
  148.         If Val(.TextMatrix(Lng_GridRow, 5)) <> 0 Then
  149.             Str_Memo = Str_Memo + "数量:" + Format(Trim(.TextMatrix(Lng_GridRow, 5)), "#,##0." + String(Xtslxsws, "0")) + Trim(.TextMatrix(Lng_GridRow, 7)) + Space(2)
  150.         End If
  151.         
  152.         '显示单价
  153.         If Val(.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) <> 0 And Val(.TextMatrix(Lng_GridRow, 5)) <> 0 Then
  154.             Str_Memo = Str_Memo + "单价:" + Format(Val(.TextMatrix(Lng_GridRow, Sydz("004", GridStr(), Szzls))) / Val(.TextMatrix(Lng_GridRow, 5)), "#,##0." + String(Xtdjxsws, "0"))
  155.         Else
  156.             If Val(.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) <> 0 And Val(.TextMatrix(Lng_GridRow, 5)) <> 0 Then
  157.                 Str_Memo = Str_Memo + "单价:" + Format(Val(.TextMatrix(Lng_GridRow, Sydz("005", GridStr(), Szzls))) / Val(.TextMatrix(Lng_GridRow, 5)), "#,##0." + String(Xtdjxsws, "0"))
  158.             End If
  159.         End If
  160.         
  161.         If Val(.TextMatrix(Lng_GridRow, 10)) <> 0 Then
  162.             Str_Memo = Str_Memo + "外币:" + Format(Trim(.TextMatrix(Lng_GridRow, 10)), "#,##0." + String(Xtjexsws, "0")) + Trim(WglrGrid.TextMatrix(Lng_GridRow, 9)) + Space(2)
  163.         End If
  164.         If Val(.TextMatrix(Lng_GridRow, 11)) <> 0 Then
  165.             Str_Memo = Str_Memo + "汇率:" + Trim(.TextMatrix(Lng_GridRow, 11)) + Space(2)
  166.         End If
  167.         If Len(Trim(.TextMatrix(Lng_GridRow, 13))) <> 0 Then
  168.             Str_Memo = Str_Memo + "部门:" + Trim(.TextMatrix(Lng_GridRow, 13)) + Space(2)
  169.         End If
  170.         If Len(Trim(.TextMatrix(Lng_GridRow, 15))) <> 0 Then
  171.             Str_Memo = Str_Memo + "客户:" + Trim(.TextMatrix(Lng_GridRow, 15)) + Space(2)
  172.         End If
  173.         If Len(Trim(.TextMatrix(Lng_GridRow, 26))) <> 0 Then
  174.             Str_Memo = Str_Memo + "供应商:" + Trim(.TextMatrix(Lng_GridRow, 26)) + Space(2)
  175.         End If
  176.         If Len(Trim(.TextMatrix(Lng_GridRow, 17))) <> 0 Then
  177.             Str_Memo = Str_Memo + "个人:" + Trim(.TextMatrix(Lng_GridRow, 17)) + Space(2)
  178.         End If
  179.         If Len(Trim(.TextMatrix(Lng_GridRow, 21))) <> 0 Then
  180.             Str_Memo = Str_Memo + "项目类别:" + Trim(.TextMatrix(Lng_GridRow, 19)) + Space(2) + "核算项目:" + Trim(.TextMatrix(Lng_GridRow, 21)) + Space(2)
  181.         End If
  182.         If Val(.TextMatrix(Lng_GridRow, 22)) <> 0 Then
  183.             Str_Memo = Str_Memo + "项目数量:" + Trim(.TextMatrix(Lng_GridRow, 22)) + Trim(.TextMatrix(Lng_GridRow, 23)) + Space(2)
  184.         End If
  185.         If Len(Trim(.TextMatrix(Lng_GridRow, 24))) <> 0 Then
  186.             Str_Memo = Str_Memo + "经办人:" + Trim(.TextMatrix(Lng_GridRow, 24))
  187.         End If
  188.         Lab_Memo(0).Caption = Str_Memo
  189.         Lab_Memo(0).Refresh
  190.     End With
  191. End Sub
  192. Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
  193.     '先关闭录入载体
  194.     changelock = True
  195.     Valilock = True
  196.     Call Ycwbk
  197.     changelock = False
  198.     Valilock = False
  199.     
  200.     Select Case Trim(Lab_OperStatus.Caption)
  201.         
  202.         
  203.     Case "2"         '修改状态
  204.         
  205.         '重新显示当前单据
  206.         
  207.         Call Sub_ShowBill
  208.         
  209.         '设置操作状态重新置为新增状态
  210.         Lab_OperStatus = "2"
  211.         Call Sub_OperStatus("30")
  212.         
  213.     End Select
  214. End Sub
  215. Private Sub Combo_Kjqj_Click()                                           '会计期间发生变化则自动计算单据编号
  216.     Call Sub_JsVouchNo
  217. End Sub
  218. Private Sub Sub_JsVouchNo()                                              '自动计算新增单据编号
  219.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  220.     
  221.     '单据为新增时才有效
  222.     If Lab_OperStatus <> "2" Then
  223.         Exit Sub
  224.     End If
  225.     Int_Year = Val(Mid(Combo_Kjqj.Text, 1, 4))
  226.     Int_Period = Val(Mid(Combo_Kjqj.Text, 6, 2))
  227.     
  228.     Sqlstr = "Select MAX(VouchNo) AS MVouchNo FROM  Cwzz_AccVouchMain Where Year='" & Int_Year & "'  AND Period='" & Int_Period & "'" & _
  229.     " AND VouchClassCode='" & Trim(LrText(0).Text) & "'"
  230.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  231.     TextChangeLock = True
  232.     If Not IsNull(RecTemp.Fields("MVouchNo")) Then
  233.         LrText(3).Text = Mid(Trim(Str(10000 + RecTemp.Fields("MVouchNo") + 1)), 2, 4)
  234.     Else
  235.         LrText(3).Text = "0001"
  236.     End If
  237.     TextChangeLock = False
  238. End Sub
  239. Private Function Sub_SaveBill() As Boolean                   '保 存 单 据
  240.     Dim Recfind As New ADODB.Recordset           '有效性判断动态集
  241.     Dim Rec_AccVouchMain As New ADODB.Recordset  '凭证主表动态集
  242.     Dim Rec_AccVouch As New ADODB.Recordset      '凭证子表动态集
  243.     Dim Rec_Ass As New ADODB.Recordset          '辅助项目记录集
  244.     
  245.     Dim jsqte As Integer                         '临时计数器
  246.     Dim Rowjsq As Long           '网格行计数器
  247.     Dim Coljsq As Long           '网格列计数器
  248.     Dim Int_RowCount As Integer  '有效数据行计数器
  249.     Dim Bln_AssVali As Boolean   '辅助核算错误标识
  250.     Dim Lrywlz As Long           '录入有误列值
  251.     Dim Dbl_Jfhj As Double       '借方合计
  252.     Dim Dbl_Dfhj As Double       '贷方合计
  253.     Dim int_sUreVouchId As Integer
  254.     
  255.     int_sUreVouchId = 0
  256.     For jsqte = 0 To Max_Text_Index
  257.         If Textint(jsqte, 8) = 1 Then     '字段不能为空
  258.             If Len(Trim(LrText(jsqte).Text)) = 0 Then
  259.                 Tsxx = Textstr(jsqte, 7) & "不能为空!"
  260.                 Call Xtxxts(Tsxx, 0, 1)
  261.                 If LrText(jsqte).Enabled = True Then LrText(jsqte).SetFocus
  262.                 Sub_SaveBill = False
  263.                 Exit Function
  264.             End If
  265.         Else
  266.             If Textint(jsqte, 8) = 2 Then   '字段不能为零
  267.                 If Val(Trim(LrText(jsqte).Text)) = 0 Then
  268.                     Tsxx = Textstr(jsqte, 7) & "不能为零!"
  269.                     Call Xtxxts(Tsxx, 0, 1)
  270.                     If LrText(jsqte).Enabled = True Then LrText(jsqte).SetFocus
  271.                     Sub_SaveBill = False
  272.                     Exit Function
  273.                 End If
  274.             End If
  275.         End If
  276.     Next jsqte
  277.     
  278.     
  279.     
  280.     '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  281.     For jsqte = 0 To Max_Text_Index
  282.         If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  283.             If Not TextYxxpd(jsqte) Then
  284.                 Exit Function
  285.             End If
  286.         End If
  287.     Next jsqte
  288.     
  289.     '[判断用户所选会计期间是否有效(非结帐月份),且制单日期必须和所选会计期间一致
  290.     Sqlstr = "Select * FROM  gy_Kjrlb Where KjYear=" & Mid(Combo_Kjqj.Text, 1, 4) & " AND period=" & Mid(Combo_Kjqj.Text, 6, 2)
  291.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  292.     With RecTemp
  293.         If Not .EOF Then
  294.             If .Fields("Cwzzjzbz") Then
  295.                 Tsxx = "所选会计期间已经结帐,不能再填制凭证!"
  296.                 Call Xtxxts(Tsxx, 0, 1)
  297.                 Combo_Kjqj.SetFocus
  298.                 Exit Function
  299.             End If
  300.             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
  301.                 Tsxx = "制单日期应在所选会计期间范围内!"
  302.                 Call Xtxxts(Tsxx, 0, 1)
  303.                 LrText(1).SetFocus
  304.                 Exit Function
  305.             End If
  306.         End If
  307.     End With
  308.     
  309.     '下面将对所有有效数据行进行有效性判断
  310.     Int_RowCount = 0
  311.     Dbl_Jfhj = 0
  312.     Dbl_Dfhj = 0
  313.     With WglrGrid
  314.         For Rowjsq = .FixedRows To .Rows
  315.             '带*号者为有效数据行
  316.             If .TextMatrix(Rowjsq, 0) <> "*" Then
  317.                 Exit For
  318.             Else
  319.                 Int_RowCount = Int_RowCount + 1
  320.             End If
  321.             
  322.             '1.首先进行为空或为零判断(固定不变)
  323.             For Coljsq = Qslz To .Cols - 1
  324.                 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
  325.                     Tsxx = GridStr(Coljsq, 2)
  326.                     Lrywlz = Coljsq
  327.                     GoTo Lrcwcl
  328.                     Exit For
  329.                 End If
  330.             Next Coljsq
  331.             
  332.             '2.[自定义判断(补丁)
  333.             If Val(Trim(.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))) = 0 And Val(Trim(.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))) = 0 Then
  334.                 Tsxx = "借方和贷方金额不能同时为零!"
  335.                 Lrywlz = Sydz("004", GridStr(), Szzls)
  336.                 GoTo Lrcwcl
  337.             End If
  338.             
  339.             If Val(Trim(.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))) <> 0 And Val(Trim(.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))) <> 0 Then
  340.                 Tsxx = "借方和贷方金额不能同时不为零!"
  341.                 Lrywlz = Sydz("004", GridStr(), Szzls)
  342.                 GoTo Lrcwcl
  343.             End If
  344.             
  345.             '判断转帐类别是否已停用
  346.             Sqlstr = "Select * FROM Cwzz_VouchClass where VouchClassCode='" & Trim(LrText(0).Text) & "'"
  347.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  348.             If RecTemp.EOF = True Then
  349.                 Tsxx = "该凭证的凭证类别不存在,不能保存!"
  350.                 Call Xtxxts(Tsxx, 0, 1)
  351.                 Exit Function
  352.             End If
  353.             '判断辅助核算项目是否填写并是否有效
  354.             
  355.             Sqlstr = "Select * FROM Cwzz_AccCode Where Ccode='" & Trim(.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) & "'"
  356.             
  357.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  358.             With RecTemp
  359.                 If .EOF Then
  360.                     Tsxx = "此科目不存在!"
  361.                     GoTo Lrcwcl
  362.                 End If
  363.                 If Not .Fields("EndFlag") Then
  364.                     Tsxx = "此科目非末级科目!"
  365.                     GoTo Lrcwcl
  366.                 End If
  367.                 If .Fields("StopFlag") Then
  368.                     Tsxx = "此科目已停用!"
  369.                     GoTo Lrcwcl
  370.                 End If
  371.                 
  372.                 '对于银行科目,如结算方式不为空则结算方式必须有效
  373.                 
  374.                 If Trim(RecTemp.Fields("Cproperty")) = "银行" And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
  375.                     Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select SSCode FROM Gy_Settlement Where SSCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 1)) & "'")
  376.                     If Recfind.EOF Then
  377.                         Tsxx = "此结算方式不存在!"
  378.                         Lrywlz = Sydz("002", GridStr(), Szzls)
  379.                         Bln_AssVali = True
  380.                         GoTo Lrcwcl
  381.                     End If
  382.                 End If
  383.                 
  384.                 '如有数量核算且用户选择数量不能为零则数量项不能为零
  385.                 
  386.                 If RecTemp.Fields("QuantityFlag") And Chk_Quantity.Value = 1 And Val(WglrGrid.TextMatrix(Rowjsq, 5)) = 0 Then
  387.                     Tsxx = "此科目需要数量核算,数量项不能为零!"
  388.                     Lrywlz = Sydz("002", GridStr(), Szzls)
  389.                     Bln_AssVali = True
  390.                     GoTo Lrcwcl
  391.                 End If
  392.                 
  393.                 
  394.                 '部门核算则部门不能为空且有效
  395.                 If RecTemp.Fields("DeptFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) = 0 Then
  396.                     Tsxx = "此科目需要部门核算,部门项不能为空!"
  397.                     Lrywlz = Sydz("002", GridStr(), Szzls)
  398.                     Bln_AssVali = True
  399.                     GoTo Lrcwcl
  400.                 Else
  401.                     If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
  402.                         Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select DeptCode FROM Gy_Department Where DeptCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 12)) & "'")
  403.                         If Recfind.EOF Then
  404.                             Tsxx = "此部门不存在!"
  405.                             Lrywlz = Sydz("002", GridStr(), Szzls)
  406.                             Bln_AssVali = True
  407.                             GoTo Lrcwcl
  408.                         End If
  409.                     End If
  410.                 End If
  411.                 
  412.                 '往来单位核算则往来单位不能为空
  413.                 If RecTemp.Fields("CusFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) = 0 Then
  414.                     Tsxx = "此科目需要往来单位核算,往来单位项不能为空"
  415.                     Lrywlz = Sydz("002", GridStr(), Szzls)
  416.                     Bln_AssVali = True
  417.                     GoTo Lrcwcl
  418.                 Else
  419.                     If RecTemp.Fields("CusFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
  420.                         Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select CusCode,StopFlag FROM Gy_Customer Where CusCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 14)) & "'")
  421.                         If Recfind.EOF Then
  422.                             Tsxx = "此往来单位不存在!"
  423.                             Lrywlz = Sydz("002", GridStr(), Szzls)
  424.                             Bln_AssVali = True
  425.                             GoTo Lrcwcl
  426.                         Else
  427.                             If Recfind.Fields("StopFlag") = True Then
  428.                                 Tsxx = "此往来单位已停用!"
  429.                                 Lrywlz = Sydz("002", GridStr(), Szzls)
  430.                                 Bln_AssVali = True
  431.                                 GoTo Lrcwcl
  432.                             End If
  433.                         End If
  434.                     End If
  435.                 End If
  436.                 
  437.                 '个人往来核算则个人项不能为空
  438.                 If RecTemp.Fields("PersonFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) = 0 Then
  439.                     Tsxx = "此科目需要个人往来核算,个人项不能为空!"
  440.                     Lrywlz = Sydz("002", GridStr(), Szzls)
  441.                     Bln_AssVali = True
  442.                     GoTo Lrcwcl
  443.                 Else
  444.                     If RecTemp.Fields("PersonFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
  445.                         Set Recfind = Cw_DataEnvi.DataConnect.Execute("Select PersonCode FROM Gy_Person Where PersonCode='" & Trim(WglrGrid.TextMatrix(Rowjsq, 16)) & "'")
  446.                         If Recfind.EOF Then
  447.                             Tsxx = "此个人不存在!"
  448.                             Lrywlz = Sydz("002", GridStr(), Szzls)
  449.                             Bln_AssVali = True
  450.                             GoTo Lrcwcl
  451.                         End If
  452.                     End If
  453.                 End If
  454.                 
  455.                 '项目核算则项目不能为空
  456.                 If RecTemp.Fields("ItemFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) = 0 Then
  457.                     Tsxx = "此科目需要项目核算,核算项目不能为空!"
  458.                     Lrywlz = Sydz("002", GridStr(), Szzls)
  459.                     Bln_AssVali = True
  460.                     GoTo Lrcwcl
  461.                 Else
  462.                     If RecTemp.Fields("ItemFlag") And Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
  463.                         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)) & "'")
  464.                         If Recfind.EOF Then
  465.                             Tsxx = "此核算项目不存在!"
  466.                             Lrywlz = Sydz("002", GridStr(), Szzls)
  467.                             Bln_AssVali = True
  468.                             GoTo Lrcwcl
  469.                         Else
  470.                             If Recfind.Fields("QuantityFlag") And Val(WglrGrid.TextMatrix(Rowjsq, 22)) = 0 Then
  471.                                 Tsxx = "此项目需数量核算,则项目数量不能为零!"
  472.                                 Lrywlz = Sydz("002", GridStr(), Szzls)
  473.                                 Bln_AssVali = True
  474.                                 GoTo Lrcwcl
  475.                             End If
  476. '**************************************************************************
  477. '   如果要限制必须是末级,可使用此代码
  478. '                            If not Recfind.Fields("EndFlag") Then
  479. '                                Tsxx = "此非末级项目!"
  480. '                                Lrywlz = Sydz("002", GridStr(), Szzls)
  481. '                                Bln_AssVali = True
  482. '                                GoTo Lrcwcl
  483. '                            End If
  484. '***************************************************************************
  485.                         End If
  486.                     End If
  487.                 End If
  488.             End With
  489.             '计算借贷方合计数据
  490.             
  491.             Dbl_Jfhj = Dbl_Jfhj + Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))
  492.             
  493.             Dbl_Dfhj = Dbl_Dfhj + Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))
  494.             
  495.         Next Rowjsq
  496.         
  497.         '会计分录行数不能为零
  498.         
  499.         If Int_RowCount = 0 Then
  500.             Tsxx = "凭证会计分录行数为零,不能存盘!"
  501.             Call Xtxxts(Tsxx, 0, 1)
  502.             Exit Function
  503.         End If
  504.         
  505.         '凭证借贷双方合计必须平衡
  506.         
  507.         If Abs(Dbl_Jfhj - Dbl_Dfhj) >= 0.01 Then
  508.             Tsxx = "凭证借贷不平衡!"
  509.             Call Xtxxts(Tsxx, 0, 1)
  510.             Exit Function
  511.         End If
  512.     End With  '网格
  513.     
  514.     
  515.     '如果以上有效性检查均顺利通过,则执行存盘动作
  516.     Int_Year = Val(Mid(Combo_Kjqj.Text, 1, 4))
  517.     
  518.     Int_Period = Val(Mid(Combo_Kjqj.Text, 6, 2))
  519.         
  520.     Call Sub_JsVouchNo
  521.     Int_VouchNo = Val(LrText(3).Text)  '凭证号
  522.     On Error GoTo Swcwcl
  523.     Cw_DataEnvi.DataConnect.BeginTrans
  524.     
  525.     
  526.     '写正式凭证
  527.     '1.判断凭证号是否重复,如重复则取最大值+1为当前凭证号,否则以当前凭证号存盘
  528.     
  529.     '打开凭证主表动态集
  530.     If Rec_AccVouchMain.State = 1 Then Rec_AccVouchMain.Close
  531.     Rec_AccVouchMain.Open "Select * From Cwzz_AccVouchMain Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  532.     With Rec_AccVouchMain
  533.         .AddNew
  534.         .Fields("VouchID") = CreatBillID("0101")
  535.         .Fields("Year") = Int_Year                                                                   '会计年度
  536.         .Fields("Period") = Int_Period                                                               '会计期间
  537.         .Fields("Ddate") = CDate(LrText(1).Text)                                                     '制单日期
  538.         .Fields("VouchClassCode") = Trim(LrText(0).Text)                                             '凭证类别
  539.         .Fields("VouchNo") = Val(Trim(LrText(3).Text))                                                            '凭证号
  540.         .Fields("Doc") = Val(LrText(2).Text)                                                         '附单据数
  541.         .Fields("Bill") = Trim(Lab_Bill.Caption)                                                     '制单人
  542.         .Fields("CheckFlag") = 0                                                                     '审核标志置"0"
  543.         .Fields("BookFlag") = 0        '记帐标志置"0"
  544.         .Fields("VouchSource") = Pub_VouchSource
  545.         .Update
  546.         int_sUreVouchId = .Fields("VouchID")
  547.         
  548.     End With
  549.     
  550.     '打开凭证子表动态集
  551.     If Rec_AccVouch.State = 1 Then Rec_AccVouch.Close
  552.     Rec_AccVouch.Open "Select * From Cwzz_AccVouchSub Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  553.     For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows
  554.         If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
  555.             Exit For
  556.         End If
  557.         With Rec_AccVouch
  558.             .AddNew
  559.             .Fields("SerialID") = Rowjsq
  560.             .Fields("VouchID") = Rec_AccVouchMain.Fields("VouchId")                                      '凭证ID
  561.             .Fields("Digest") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)))         '摘要
  562.             .Fields("Ccode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))          '会计科目
  563.             .Fields("Jfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))            '借方金额
  564.             .Fields("Dfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))            '贷方金额
  565.             If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  566.                 .Fields("Jfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5))                                     '借方数量
  567.             Else
  568.                 .Fields("Dfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5))                                     '贷方数量
  569.             End If
  570.             '如为外币核算则原币编码为外币编码否则填充本位币编码,同时填充原币金额
  571.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 8))) <> 0 And Trim(WglrGrid.TextMatrix(Rowjsq, 8)) <> XtSCurrCode Then
  572.                 .Fields("ForeignCurrCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 8))                         '外币编码
  573.                 .Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, 11))                                 '记帐汇率
  574.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  575.                     .Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10))                               '本币借方金额
  576.                 Else
  577.                     .Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10))                               '本币贷方金额
  578.                 End If
  579.             Else
  580.                 .Fields("ForeignCurrCode") = XtSCurrCode                                                  '原币编码
  581.                 .Fields("AccRate") = 1                                                                    '记帐汇率
  582.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  583.                     .Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))    '原币借方金额
  584.                 Else
  585.                     .Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))    '原币贷方金额
  586.                 End If
  587.             End If
  588.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) <> 0 Then
  589.                 .Fields("BillDate") = CDate(Trim(WglrGrid.TextMatrix(Rowjsq, 4)))                         '发生日期(银行)
  590.             End If
  591.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
  592.                 .Fields("SScode") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                                  '结算方式(银行)
  593.             End If
  594.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 3))) <> 0 Then
  595.                 .Fields("BillNo") = Trim(WglrGrid.TextMatrix(Rowjsq, 3))                                  '票号(银行)
  596.             End If
  597.             .Fields("BCheckFlag") = 0                                                                    '银行核对标志置0
  598.             .Fields("BDelete") = 0                                                                       '银行帐核销标志置0
  599.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
  600.                 .Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 16))                             '职员编码
  601.             End If
  602.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
  603.                 .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 12))                               '部门编码
  604.             End If
  605.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
  606.                 .Fields("CusCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 14))                                '往来客户编码
  607.             End If
  608.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 25))) <> 0 Then
  609.                 .Fields("Suppliercode") = Trim(WglrGrid.TextMatrix(Rowjsq, 25))                          '往来供应商编码
  610.             End If
  611.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 18))) <> 0 Then
  612.                 .Fields("ItemClassCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 18))                          '项目大类编码
  613.             End If
  614.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
  615.                 .Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 20))                               '项目编码
  616.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  617.                     .Fields("ItemJfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22))                            '项目借方数量
  618.                 Else
  619.                     .Fields("ItemDfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22))                            '项目贷方数量
  620.                 End If
  621.             End If
  622.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 24))) <> 0 Then
  623.                 .Fields("TranPerson") = Trim(WglrGrid.TextMatrix(Rowjsq, 24))                             '经办人
  624.             End If
  625.             .Update
  626.         End With
  627.     Next Rowjsq
  628.     
  629.     '写临时凭证开始 '与 Save_VouchTemp 基本相同
  630.     '[写入临时凭证主表
  631.     If Rec_VouchMainTemp.State = 1 Then Rec_VouchMainTemp.Close
  632.     Rec_VouchMainTemp.Open "Select * From Cwzz_AccVouchMainTemp Where VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  633.     With Rec_VouchMainTemp
  634.         .Fields("Year") = Int_Year                                                                   '会计年度
  635.         .Fields("Period") = Int_Period                                                               '会计期间
  636.         .Fields("Ddate") = CDate(LrText(1).Text)                                                     '制单日期
  637.         .Fields("VouchClassCode") = Trim(LrText(0).Text)                                             '凭证类别
  638.         .Fields("Doc") = Val(LrText(2).Text)                                                         '附单据数
  639.         .Fields("Bill") = Trim(Lab_Bill.Caption)                                                     '制单人
  640.         .Fields("VouchNo") = Int(Int_VouchNo)                                                 '若已生成正式凭证应记录生成的凭证号
  641.         .Fields("SureVouchId") = int_sUreVouchId
  642.         .Update
  643.     End With
  644.     
  645.     '写临时凭证辅表
  646.     Cw_DataEnvi.DataConnect.Execute "delete from Cwzz_AccVouchSubTemp where VouchId='" & Lab_VouchId & "'"
  647.     If Rec_VouchTemp.State = 1 Then Rec_VouchTemp.Close
  648.     Rec_VouchTemp.Open "Select * From Cwzz_AccVouchSubTemp Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  649.     For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows
  650.         If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
  651.             Exit For
  652.         End If
  653.         With Rec_VouchTemp
  654.             .AddNew
  655.             .Fields("SerialID") = Rowjsq
  656.             .Fields("VouchId") = Int(Trim(Lab_VouchId.Caption))                                      '凭证ID
  657.             .Fields("Digest") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)))         '摘要
  658.             .Fields("Ccode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))          '会计科目
  659.             .Fields("Jfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))            '借方金额
  660.             .Fields("Dfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))            '贷方金额
  661.             If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  662.                 .Fields("Jfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5))                                     '借方数量
  663.             Else
  664.                 .Fields("Dfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5))                                     '贷方数量
  665.             End If
  666.             
  667.             '如为外币核算则原币编码为外币编码否则填充本位币编码,同时填充原币金额
  668.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 8))) <> 0 And Trim(WglrGrid.TextMatrix(Rowjsq, 8)) <> XtSCurrCode Then
  669.                 .Fields("ForeignCurrCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 8))                         '外币编码
  670.                 .Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, 11))                                 '记帐汇率
  671.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  672.                     .Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10))                               '原币借方金额
  673.                 Else
  674.                     .Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10))                               '原币贷方金额
  675.                 End If
  676.             Else
  677.                 .Fields("ForeignCurrCode") = XtSCurrCode                                                  '原币编码
  678.                 .Fields("AccRate") = 1                                                                    '记帐汇率
  679.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  680.                     .Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))    '原币借方金额
  681.                 Else
  682.                     .Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))    '原币贷方金额
  683.                 End If
  684.             End If
  685.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) <> 0 Then
  686.                 .Fields("BillDate") = CDate(Trim(WglrGrid.TextMatrix(Rowjsq, 4)))                         '发生日期(银行)
  687.             End If
  688.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
  689.                 .Fields("SScode") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                                  '结算方式(银行)
  690.             End If
  691.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 3))) <> 0 Then
  692.                 .Fields("BillNo") = Trim(WglrGrid.TextMatrix(Rowjsq, 3))                                  '票号(银行)
  693.             End If
  694.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
  695.                 .Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 16))                             '职员编码
  696.             End If
  697.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
  698.                 .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 12))                               '部门编码
  699.             End If
  700.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
  701.                 .Fields("CusCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 14))                                '往来客户编码
  702.             End If
  703.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 25))) <> 0 Then
  704.                 .Fields("Suppliercode") = Trim(WglrGrid.TextMatrix(Rowjsq, 25))                          '往来供应商编码
  705.             End If
  706.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 18))) <> 0 Then
  707.                 .Fields("ItemClassCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 18))                          '项目大类编码
  708.             End If
  709.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
  710.                 .Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 20))                               '项目编码
  711.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  712.                     .Fields("ItemJfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22))                             '项目借方数量
  713.                 Else
  714.                     .Fields("ItemDfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22))                             '项目贷方数量
  715.                 End If
  716.             End If
  717.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 24))) <> 0 Then
  718.                 .Fields("TranPerson") = Trim(WglrGrid.TextMatrix(Rowjsq, 24))                             '经办人
  719.             End If
  720.             .Update
  721.         End With
  722.     Next Rowjsq
  723.     ']写临时凭证结束
  724.     
  725.     
  726.     Lab_Succeed.Visible = True
  727.     Lab_Succeed.Caption = "已生成"
  728.     
  729.     Cw_DataEnvi.DataConnect.CommitTrans
  730.     Sub_SaveBill = True
  731.     Tsxx = "凭证号:" & Trim(LrText(0).Text) & "--" & Trim(LrText(3).Text) & "保存完毕! "
  732.     Call Xtxxts(Tsxx, 0, 4)
  733.     
  734.     '标识单据发生改动
  735.     Bln_BillChange = True
  736.     
  737.     '设置操作状态为浏览
  738.     Lab_OperStatus = "1"
  739.     Call Sub_OperStatus("11")
  740.     
  741.     Exit Function
  742. Swcwcl:
  743.     Cw_DataEnvi.DataConnect.RollbackTrans
  744.     Lab_Succeed.Caption = ""
  745.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  746.     Call Xtxxts(Tsxx, 0, 1)
  747.     Exit Function
  748. Lrcwcl:        '录入错误处理
  749.     With WglrGrid
  750.         Call Xtxxts("(第 " + Trim(Str(Int_RowCount)) + " 条会计分录)-" + Tsxx, 0, 1)
  751.         changelock = True
  752.         .Select Rowjsq, Lrywlz
  753.         WglrGrid.SetFocus
  754.         changelock = False
  755.         Exit Function
  756.     End With
  757. End Function
  758. Private Sub Chk_DeleteMess_Click()                   '删行是否提示(点击)
  759.     If Chk_DeleteMess.Value = 1 Then
  760.         Shsfts = True
  761.     Else
  762.         Shsfts = False
  763.     End If
  764. End Sub
  765. '选择首张,上张,下张,末张
  766. Private Sub Sub_First()             '首 张
  767.     If Val(Lab_VouchId.Caption) = Min_VouchIdTemp Then   'Lab_VouchId用于标识临时凭证主表和辅表的关联Id
  768.         Exit Sub
  769.     End If
  770.     If Lab_Succeed.Caption = "" Then         '首先保存该凭证到临时表中
  771.         Call Save_VouchTemp
  772.     End If
  773.     Rec_TranMainTemp.MoveFirst
  774.     Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
  775.     Call Sub_ShowBill
  776. End Sub
  777. Private Sub Sub_Prev()             '上 张
  778.     If Val(Lab_VouchId.Caption) = Min_VouchIdTemp Then
  779.         Exit Sub
  780.     End If
  781.     If Lab_Succeed.Caption = "" Then         '首先保存该凭证到临时表中
  782.         Call Save_VouchTemp
  783.     End If
  784.     Rec_TranMainTemp.MovePrevious
  785.     If Rec_TranMainTemp.BOF = True Then
  786.         Rec_TranMainTemp.MoveNext
  787.     End If
  788.     Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
  789.     Call Sub_ShowBill
  790. End Sub
  791. Private Sub Sub_next()             '下 张
  792.     If Val(Lab_VouchId.Caption) = Max_VouchIdTemp Then
  793.         Exit Sub
  794.     End If
  795.     If Lab_Succeed.Caption = "" Then         '首先保存该凭证到临时表中
  796.         Call Save_VouchTemp
  797.     End If
  798.     Rec_TranMainTemp.MoveNext
  799.     If Rec_TranMainTemp.EOF = True Then
  800.         Rec_TranMainTemp.MovePrevious
  801.     End If
  802.     Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
  803.     Call Sub_ShowBill
  804. End Sub
  805. Private Sub Sub_Last()              '末 张
  806.     If Val(Lab_VouchId.Caption) = Max_VouchIdTemp Then
  807.         Exit Sub
  808.     End If
  809.     If Lab_Succeed.Caption = "" Then         '首先保存该凭证到临时表中
  810.         Call Save_VouchTemp
  811.     End If
  812.     Rec_TranMainTemp.MoveLast
  813.     Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
  814.     Call Sub_ShowBill
  815. End Sub
  816. Public Sub Sub_Scpzbb(Cxsjwg As VSFlexGrid)                            '生成预览凭证报表
  817.     
  818.     '过程参数:输出数据网格
  819.     
  820.     Dim Yxhzjsq%, Yxlzjsq%       '有效列值计数器,有效行值计数器
  821.     Dim Rowjsq As Long           '临时行计数器
  822.     Dim Sjhjsq As Long           '数据行计数器
  823.     Dim Int_Pzmyhs As Integer    '凭证每页数据行数
  824.     Dim Dbl_Jfhj As Double       '借方合计
  825.     Dim Dbl_Dfhj As Double       '贷方合计
  826.     
  827.     '生成有效数据表
  828.     With DY_Tybbyldy.DyylGrid
  829.         .FontName = Cxsjwg.FontName
  830.         .FontSize = Cxsjwg.FontSize
  831.         .FixedRows = Cxsjwg.FixedRows
  832.         .MergeCells = flexMergeFixedOnly
  833.         For jsqte = 0 To .FixedRows - 1
  834.             .MergeRow(jsqte) = True
  835.         Next jsqte
  836.         .WordWrap = True
  837.         
  838.         '重置数据列
  839.         Yxlzjsq = 4
  840.         .Cols = Yxlzjsq
  841.         
  842.         .ColAlignment(2) = Cxsjwg.ColAlignment(Sydz("004", GridStr(), Szzls))
  843.         .ColAlignment(3) = Cxsjwg.ColAlignment(Sydz("005", GridStr(), Szzls))
  844.         .ColWidth(0) = Cxsjwg.ColWidth(Sydz("001", GridStr(), Szzls))
  845.         .ColWidth(1) = Cxsjwg.ColWidth(Sydz("002", GridStr(), Szzls)) + Cxsjwg.ColWidth(Sydz("003", GridStr(), Szzls))
  846.         .ColWidth(2) = Cxsjwg.ColWidth(Sydz("004", GridStr(), Szzls))
  847.         .ColWidth(3) = Cxsjwg.ColWidth(Sydz("005", GridStr(), Szzls))
  848.         .ColFormat(2) = Cxsjwg.ColFormat(Sydz("004", GridStr(), Szzls))
  849.         .ColFormat(3) = Cxsjwg.ColFormat(Sydz("005", GridStr(), Szzls))
  850.         
  851.         For Yxlzjsq = 0 To 3
  852.             .MergeCol(Yxlzjsq) = True
  853.         Next Yxlzjsq
  854.         
  855.         '重置数据行
  856.         
  857.         Yxhzjsq = 0
  858.         For Rowjsq = 0 To Cxsjwg.Rows - 1
  859.             If (Not Cxsjwg.RowHidden(Rowjsq)) And (Not GridRowEmpty(Cxsjwg, Rowjsq)) Then
  860.                 Yxhzjsq = Yxhzjsq + 1
  861.             End If
  862.         Next Rowjsq
  863.         .Rows = Yxhzjsq
  864.         
  865.         
  866.         .TextMatrix(0, 0) = Cxsjwg.TextMatrix(0, Sydz("001", GridStr(), Szzls))
  867.         .TextMatrix(0, 1) = "科  目  名  称"
  868.         .TextMatrix(0, 2) = Cxsjwg.TextMatrix(0, Sydz("004", GridStr(), Szzls))
  869.         .TextMatrix(0, 3) = Cxsjwg.TextMatrix(0, Sydz("005", GridStr(), Szzls))
  870.         .RowHeight(0) = Cxsjwg.RowHeight(0)
  871.         
  872.         
  873.         Yxhzjsq = Cxsjwg.FixedRows
  874.         
  875.         For Rowjsq = Cxsjwg.FixedRows To Cxsjwg.Rows - 1
  876.             If (Not Cxsjwg.RowHidden(Rowjsq)) And (Not GridRowEmpty(Cxsjwg, Rowjsq)) Then
  877.                 
  878.                 '摘要
  879.                 .TextMatrix(Yxhzjsq, 0) = Cxsjwg.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))
  880.                 
  881.                 '输出科目名称
  882.                 If Chk_CodeOutput.Value = 1 Then
  883.                     .TextMatrix(Yxhzjsq, 1) = Cxsjwg.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) + " " + Cxsjwg.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls))
  884.                 Else
  885.                     .TextMatrix(Yxhzjsq, 1) = Cxsjwg.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls))
  886.                 End If
  887.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 2)) <> "" Then    '结算方式
  888.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 2))
  889.                 End If
  890.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 3)) <> "" Then    '票号
  891.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 3))
  892.                 End If
  893.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 4)) <> "" Then    '发生日期
  894.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 4))
  895.                 End If
  896.                 If Val(Cxsjwg.TextMatrix(Rowjsq, 5)) <> 0 Then      '数量
  897.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 5)) + Trim(Cxsjwg.TextMatrix(Rowjsq, 7))
  898.                 End If
  899.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 9)) <> "" Then    '外币名称
  900.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 10)) + Trim(Cxsjwg.TextMatrix(Rowjsq, 9))
  901.                 End If
  902.                 If Val(Cxsjwg.TextMatrix(Rowjsq, 11)) <> 0 Then      '记帐汇率
  903.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + "汇率:" + Trim(Cxsjwg.TextMatrix(Rowjsq, 11))
  904.                 End If
  905.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 13)) <> "" Then    '部门
  906.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 13))
  907.                 End If
  908.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 15)) <> "" Then    '往来客户
  909.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 15))
  910.                 End If
  911.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 26)) <> "" Then    '往来供应商
  912.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 26))
  913.                 End If
  914.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 17)) <> "" Then    '职员
  915.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 17))
  916.                 End If
  917.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 19)) <> "" Then    '项目大类
  918.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 19))
  919.                 End If
  920.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 21)) <> "" Then    '项目名称
  921.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 21))
  922.                 End If
  923.                 If Val(Cxsjwg.TextMatrix(Rowjsq, 22)) <> 0 Then      '项目数量单位
  924.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + Trim(Cxsjwg.TextMatrix(Rowjsq, 22)) + Trim(Cxsjwg.TextMatrix(Rowjsq, 23))
  925.                 End If
  926.                 If Trim(Cxsjwg.TextMatrix(Rowjsq, 24)) <> "" Then    '经办人
  927.                     .TextMatrix(Yxhzjsq, 1) = .TextMatrix(Yxhzjsq, 1) + Space(2) + "经办人:" + Trim(Cxsjwg.TextMatrix(Rowjsq, 24))
  928.                 End If
  929.                 
  930.                 '借方金额
  931.                 .TextMatrix(Yxhzjsq, 2) = Cxsjwg.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))
  932.                 
  933.                 '贷方金额
  934.                 .TextMatrix(Yxhzjsq, 3) = Cxsjwg.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))
  935.                 
  936.                 .RowHeight(Yxhzjsq) = Cxsjwg.RowHeight(Rowjsq)
  937.                 Yxhzjsq = Yxhzjsq + 1
  938.             End If
  939.         Next Rowjsq
  940.         
  941.         '补空行和添加分页合计
  942.         Int_Pzmyhs = 6
  943.         
  944.         If .Rows - .FixedRows = 0 Then
  945.             Exit Sub
  946.         Else
  947.             If (.Rows - .FixedRows) Mod Int_Pzmyhs <> 0 Then
  948.                 For jsqte = 1 To Int_Pzmyhs - ((.Rows - .FixedRows) Mod Int_Pzmyhs)
  949.                     .AddItem ""
  950.                     .RowHeight(.Rows - 1) = Sjhgd
  951.                 Next jsqte
  952.             End If
  953.         End If
  954.         
  955.         Dbl_Jfhj = 0
  956.         Dbl_Dfhj = 0
  957.         Sjhjsq = 1
  958.         Rowjsq = .FixedRows
  959.         Do While Rowjsq <= .Rows - 1
  960.             
  961.             Dbl_Jfhj = Dbl_Jfhj + Val(.TextMatrix(Rowjsq, 2))
  962.             Dbl_Dfhj = Dbl_Dfhj + Val(.TextMatrix(Rowjsq, 3))
  963.             
  964.             If Sjhjsq Mod Int_Pzmyhs = 0 Then
  965.                 Rowjsq = Rowjsq + 1
  966.                 .AddItem "", Rowjsq
  967.                 .RowHeight(Rowjsq) = Sjhgd
  968.                 .TextMatrix(Rowjsq, 0) = "合 计"
  969.                 .TextMatrix(Rowjsq, 2) = Format(Dbl_Jfhj, "##." + String(Xtjexsws, "0"))
  970.                 .TextMatrix(Rowjsq, 3) = Format(Dbl_Dfhj, "##." + String(Xtjexsws, "0"))
  971.                 
  972.                 '最后合计输出金额大写
  973.                 If Rowjsq = .Rows - 1 Then
  974.                     .TextMatrix(Rowjsq, 1) = Fun_Jezh(Dbl_Jfhj)
  975.                 End If
  976.             End If
  977.             
  978.             Sjhjsq = Sjhjsq + 1
  979.             Rowjsq = Rowjsq + 1
  980.             
  981.         Loop
  982.     End With
  983.     
  984. End Sub
  985. Public Sub Read_Data()                  '从临时凭证主表中读本批临时凭证记录集
  986.     If Rec_TranMainTemp.State = 1 Then Rec_TranMainTemp.Close
  987.     
  988.     Sqlstr = "select * from Cwzz_AccVouchMainTemp Where OperationNo='" & Lab_OperNum.Caption & "' ORDER BY VouchId"
  989.     Set Rec_TranMainTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  990.     If Not Rec_TranMainTemp.EOF Then
  991.         Rec_TranMainTemp.MoveLast
  992.         Max_VouchIdTemp = Rec_TranMainTemp.Fields("VouchId")    '最大值
  993.         Lab_VouchId.Caption = Trim(Rec_TranMainTemp.Fields("VouchId"))
  994.         Rec_TranMainTemp.MoveFirst
  995.         Min_VouchIdTemp = Rec_TranMainTemp.Fields("VouchId")    '最小值
  996.         Lab_VouchSource.Caption = Trim(Rec_TranMainTemp.Fields("VouchSource"))
  997.     End If
  998. End Sub
  999. Private Sub Save_VouchTemp()            '写临时凭证
  1000.     On Error GoTo Swcwcl
  1001.     '写临时凭证,与Save_Bill中的写临时凭证程序片段相同
  1002.     '写入临时凭证主表
  1003.     Cw_DataEnvi.DataConnect.BeginTrans
  1004.     If Rec_VouchMainTemp.State = 1 Then Rec_VouchMainTemp.Close
  1005.     Rec_VouchMainTemp.Open "Select * From Cwzz_AccVouchMainTemp Where VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1006.     With Rec_VouchMainTemp
  1007.         .Fields("Year") = Int_Year                                                                   '会计年度
  1008.         .Fields("Period") = Int_Period                                                               '会计期间
  1009.         .Fields("Ddate") = CDate(LrText(1).Text)                                                     '制单日期
  1010.         .Fields("VouchClassCode") = Trim(LrText(0).Text)                                             '凭证类别
  1011.         .Fields("Doc") = Val(LrText(2).Text)                                                         '附单据数
  1012.         .Fields("Bill") = Trim(Lab_Bill.Caption)                                                     '制单人
  1013.         '与SaveBill的不同之处是不填写"VouchNo"的值
  1014.         .Update
  1015.     End With
  1016.     
  1017.     '写临时凭证辅表
  1018.     Cw_DataEnvi.DataConnect.Execute "delete from Cwzz_AccVouchSubTemp where VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "'"
  1019.     If Rec_VouchTemp.State = 1 Then Rec_VouchTemp.Close
  1020.     Rec_VouchTemp.Open "Select * From Cwzz_AccVouchSubTemp Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1021.     For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows
  1022.         If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
  1023.             Exit For
  1024.         End If
  1025.         With Rec_VouchTemp
  1026.             .AddNew
  1027.             .Fields("SerialID") = Rowjsq
  1028.             .Fields("VouchId") = Int(Trim(Lab_VouchId.Caption))                                      '凭证ID
  1029.             .Fields("Digest") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)))         '摘要
  1030.             If Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls))) = "" Then
  1031.                 .Fields("Ccode") = Null
  1032.             Else
  1033.                 .Fields("Ccode") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))          '会计科目
  1034.             End If
  1035.             .Fields("Jfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))            '借方金额
  1036.             .Fields("Dfje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))            '贷方金额
  1037.             If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  1038.                 .Fields("Jfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5))                                     '借方数量
  1039.             Else
  1040.                 .Fields("Dfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 5))                                     '贷方数量
  1041.             End If
  1042.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 8))) <> 0 Then
  1043.                 .Fields("ForeignCurrCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 8))                         '外币编码
  1044.                 .Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, 11))                                 '记帐汇率
  1045.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  1046.                     .Fields("Wbjfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10))                               '外币借方金额
  1047.                 Else
  1048.                     .Fields("Wbdfje") = Val(WglrGrid.TextMatrix(Rowjsq, 10))                               '外币贷方金额
  1049.                 End If
  1050.             End If
  1051.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 4))) <> 0 Then
  1052.                 .Fields("BillDate") = CDate(Trim(WglrGrid.TextMatrix(Rowjsq, 4)))                         '发生日期(银行)
  1053.             End If
  1054.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 1))) <> 0 Then
  1055.                 .Fields("SScode") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                                  '结算方式(银行)
  1056.             End If
  1057.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 3))) <> 0 Then
  1058.                 .Fields("BillNo") = Trim(WglrGrid.TextMatrix(Rowjsq, 3))                                  '票号(银行)
  1059.             End If
  1060.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 16))) <> 0 Then
  1061.                 .Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 16))                             '职员编码
  1062.             End If
  1063.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 12))) <> 0 Then
  1064.                 .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 12))                               '部门编码
  1065.             End If
  1066.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 14))) <> 0 Then
  1067.                 .Fields("CusCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 14))                                '往来客户编码
  1068.             End If
  1069.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 25))) <> 0 Then
  1070.                 .Fields("Suppliercode") = Trim(WglrGrid.TextMatrix(Rowjsq, 25))                          '往来供应商编码
  1071.             End If
  1072.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 18))) <> 0 Then
  1073.                 .Fields("ItemClassCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 18))                          '项目大类编码
  1074.             End If
  1075.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 20))) <> 0 Then
  1076.                 .Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Rowjsq, 20))                               '项目编码
  1077.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
  1078.                     .Fields("ItemJfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22))                             '项目借方数量
  1079.                 Else
  1080.                     .Fields("ItemDfsl") = Val(WglrGrid.TextMatrix(Rowjsq, 22))                             '项目贷方数量
  1081.                 End If
  1082.             End If
  1083.             If Len(Trim(WglrGrid.TextMatrix(Rowjsq, 24))) <> 0 Then
  1084.                 .Fields("TranPerson") = Trim(WglrGrid.TextMatrix(Rowjsq, 24))                             '经办人
  1085.             End If
  1086.             .Update
  1087.         End With
  1088.     Next Rowjsq
  1089.     Cw_DataEnvi.DataConnect.CommitTrans
  1090.     Exit Sub
  1091. Swcwcl:
  1092.     Cw_DataEnvi.DataConnect.RollbackTrans
  1093.     Lab_Succeed.Caption = ""
  1094.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  1095.     Call Xtxxts(Tsxx, 0, 1)
  1096.     Exit Sub
  1097. End Sub
  1098. Private Sub Quit()  '退出自动转帐程序
  1099.     '判断是否有没有存盘的转帐凭证
  1100.     Sqlstr = "Select 1 from Cwzz_AccVouchMainTemp Where (VouchNo is Null or VouchNo=0) and OperationNo='" & Lab_OperNum.Caption & "' order by VouchId"
  1101.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1102.     If RecTemp.EOF = False Then         '若有
  1103.         AutoTran_NoSaveList.Show 1
  1104.         Tsxx = "凭证没有全部保存,退出吗?"
  1105.         If Xtxxts(Tsxx, 1, 2) = 6 Then  '若退出
  1106.             GoTo zy
  1107.         End If
  1108.     Else
  1109.         GoTo zy
  1110.     End If
  1111.     Exit Sub
  1112. zy:
  1113.     Unload Me
  1114.     Exit Sub
  1115. End Sub
  1116. Private Sub Sub_FillPeriTran()
  1117.     '填充转帐会计日历
  1118.     Sqlstr = "select * from Cwzz_V_AccVouchTempCh where OperationNo='" & Lab_OperNum.Caption & "' and VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "' "
  1119.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1120.     If RecTemp.EOF = True Then
  1121.         Exit Sub
  1122.     End If
  1123.     Call Sub_FillPeriod(Combo_Kjqj, RecTemp.Fields("Year"), RecTemp.Fields("period"))
  1124. End Sub
  1125. '**************************************************************************************'
  1126. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
  1127. Private Sub Sub_AdjustGrid()
  1128.     '调 整 网 格
  1129.     With WglrGrid
  1130.         '加 1 保持一行录入行
  1131.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1132.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1133.             For jsqte = .FixedRows To .Rows - 1
  1134.                 .RowHeight(jsqte) = Sjhgd
  1135.             Next jsqte
  1136.         Else
  1137.             '判断是否有辅助行和录入行,如没有则加行
  1138.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  1139.                 .AddItem ""
  1140.                 .RowHeight(.Rows - 1) = Sjhgd
  1141.             Loop
  1142.         End If
  1143.     End With
  1144. End Sub
  1145. Private Sub Lrzdbz()                                                      '录入字段帮助
  1146.     If Not Ydcommand.Visible Then
  1147.         Exit Sub
  1148.     End If
  1149.     Valilock = True
  1150.     With WglrGrid
  1151.         
  1152.         '[>>会计科目编码帮助单独处理
  1153.         If .Col = Sydz("002", GridStr(), Szzls) Then
  1154.             Xtcdcs = Trim(Ydtext.Text)
  1155.             PZ_FrmKjkmcz.Show 1
  1156.             If Len(Xtfhcs) <> 0 Then
  1157.                 Ydtext.Text = Xtfhcs
  1158.             End If
  1159.         Else
  1160.             
  1161.             '处理通用部分
  1162.             changelock = True        '调入另外窗体必须加锁
  1163.             Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  1164.             changelock = False
  1165.             If Len(Xtfhcs) <> 0 Then
  1166.                 If GridInt(.Col, 7) = 0 Then
  1167.                     Ydtext.Text = Xtfhcs
  1168.                 Else
  1169.                     Ydtext.Text = Xtfhcsfz
  1170.                 End If
  1171.             End If
  1172.         End If
  1173.         '[>>处理完毕
  1174.         
  1175.         Valilock = False
  1176.         If Ydtext.Visible Then
  1177.             Ydtext.SetFocus
  1178.         End If
  1179.     End With
  1180. End Sub
  1181. Private Sub Cshhjwg()                                                     '初始化合计网格(*对合计网格来说,录入网格为容器)
  1182.     Dim Lrwglkd As Double
  1183.     Dim Hjwgpyl As Integer
  1184.     With HjGrid
  1185.         If Not Sfxshjwg Then
  1186.             .Visible = False
  1187.             Exit Sub
  1188.         Else
  1189.             .Visible = True
  1190.         End If
  1191.         .Enabled = False
  1192.         .Appearance = flexFlat
  1193.         .BorderStyle = flexBorderNone
  1194.         .ScrollBars = flexScrollBarNone
  1195.         .Width = WglrGrid.Width
  1196.         .FixedRows = 0
  1197.         .Rows = 1
  1198.         .Cols = WglrGrid.Cols
  1199.         .LeftCol = WglrGrid.LeftCol
  1200.         .TextMatrix(0, Qslz) = "合  计"
  1201.         For jsqte = 0 To WglrGrid.Cols - 1
  1202.             .ColHidden(jsqte) = WglrGrid.ColHidden(jsqte)
  1203.             .ColWidth(jsqte) = WglrGrid.ColWidth(jsqte)
  1204.             .ColAlignment(jsqte) = WglrGrid.ColAlignment(jsqte)
  1205.             .ColFormat(jsqte) = WglrGrid.ColFormat(jsqte)
  1206.         Next jsqte
  1207.         .ColAlignment(Qslz) = flexAlignCenterTop
  1208.         For jsqte = .FixedRows To .Rows - 1
  1209.             .RowHeight(jsqte) = .Height / .Rows
  1210.         Next jsqte
  1211.         .Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
  1212.     End With
  1213. End Sub
  1214. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  1215.     Call Cxxswbk
  1216. End Sub
  1217. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1218.     Fun_Drfrmyxxpd = True
  1219.     With WglrGrid
  1220.         
  1221.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1222.         
  1223.         If Ydtext.Visible Or YdCombo.Visible Then
  1224.             Call Lrsjhx
  1225.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1226.                 Fun_Drfrmyxxpd = False
  1227.                 Exit Function
  1228.             End If
  1229.         End If
  1230.         
  1231.         '进行行有效性判断
  1232.         If Not Sjhzyxxpd(.Row) Then
  1233.             Fun_Drfrmyxxpd = False
  1234.             Exit Function
  1235.         End If
  1236.         
  1237.     End With
  1238. End Function
  1239. Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long)       '调整列宽
  1240.     If HjGrid.Visible Then
  1241.         With HjGrid
  1242.             .ColWidth(Col) = WglrGrid.ColWidth(Col)
  1243.         End With
  1244.     End If
  1245. End Sub
  1246. Private Sub WglrGrid_EnterCell()                                    '显示当前数据行相关信息
  1247.     With WglrGrid
  1248.         If .Row >= .FixedRows Then
  1249.             Lab_Row = Trim(Str(.Row - .FixedRows + 1))
  1250.             
  1251.             '显示备注信息
  1252.             Call Sub_ShowMemo(WglrGrid.Row)
  1253.         End If
  1254.     End With
  1255. End Sub
  1256. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1257.     
  1258.     '网格得到焦点,如果当前选择行为非数据行
  1259.     '则调整当前焦点至有效数据行
  1260.     
  1261.     With WglrGrid
  1262.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1263.             changelock = True
  1264.             .Select .FixedRows, .Col
  1265.             changelock = False
  1266.         End If
  1267.         If .Col < Qslz Then
  1268.             changelock = True
  1269.             .Select .Row, Qslz
  1270.             changelock = False
  1271.         End If
  1272.     End With
  1273.     
  1274. End Sub
  1275. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1276.     
  1277.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1278.     If changelock Then
  1279.         Exit Sub
  1280.     End If
  1281.     
  1282.     '引发网格RowcolChange事件
  1283.     With WglrGrid
  1284.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1285.             .Select 0, 0
  1286.         End If
  1287.     End With
  1288.     
  1289. End Sub
  1290. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1291.     If Gdtlock Then
  1292.         Exit Sub
  1293.     End If
  1294.     With WglrGrid
  1295.         If Ydtext.Visible Or YdCombo.Visible Then
  1296.             Gdtlock = True
  1297.             .TopRow = Dqtoprow
  1298.             .LeftCol = Dqleftcol
  1299.             Gdtlock = False
  1300.             Exit Sub
  1301.         End If
  1302.         HjGrid.LeftCol = .LeftCol
  1303.     End With
  1304. End Sub
  1305. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1306.     If changelock Then
  1307.         Exit Sub
  1308.     End If
  1309.     
  1310.     '记录刚刚离开网格单元的行列值
  1311.     Dqlkwgh = WglrGrid.Row
  1312.     Dqlkwgl = WglrGrid.Col
  1313.     
  1314.     '判断是否需要录入数据回写
  1315.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1316.         Exit Sub
  1317.     End If
  1318.     Call Lrsjhx
  1319. End Sub
  1320. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1321.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1322.     With WglrGrid
  1323.         If changelock Then
  1324.             Exit Sub
  1325.         End If
  1326.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1327.             Exit Sub
  1328.         End If
  1329.         If .Row <> Dqlkwgh Then
  1330.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1331.                 Exit Sub
  1332.             End If
  1333.         End If
  1334.     End With
  1335.     Call fhyxh
  1336.     Call Xldql
  1337. End Sub
  1338. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1339.     With WglrGrid
  1340.         Call xswbk
  1341.     End With
  1342. End Sub
  1343. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1344.     Valilock = True
  1345.     Ydtext.Visible = False
  1346.     YdCombo.Visible = False
  1347.     Ydcommand.Visible = False
  1348. End Sub
  1349. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1350.     With WglrGrid
  1351.         Select Case KeyCode
  1352.         Case vbKeyEscape                'ESC 键放弃录入
  1353.             Valilock = True
  1354.             .SetFocus
  1355.             Call Ycwbk
  1356.             Valilock = False
  1357.         Case vbKeyReturn                '回 车 键 =13
  1358.             KeyCode = 0
  1359.             .SetFocus
  1360.             Call Lrsjhx
  1361.             Rowjsq = .Row
  1362.             Coljsq = .Col + 1
  1363.             If Coljsq > .Cols - 1 Then
  1364.                 If Rowjsq < .Rows - 1 Then
  1365.                     Rowjsq = Rowjsq + 1
  1366.                 End If
  1367.                 Coljsq = Qslz
  1368.             End If
  1369.             Do While Rowjsq <= .Rows - 1
  1370.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1371.                     Coljsq = Coljsq + 1
  1372.                     If Coljsq > .Cols - 1 Then
  1373.                         Rowjsq = Rowjsq + 1
  1374.                         Coljsq = Qslz
  1375.                     End If
  1376.                 Else
  1377.                     Exit Do
  1378.                 End If
  1379.             Loop
  1380.             .Select Rowjsq, Coljsq
  1381.         Case vbKeyLeft                  '左 箭 头 =37
  1382.             If .Col - 1 = Qslz Then
  1383.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1384.                     GoTo jzzx
  1385.                 End If
  1386.             End If
  1387.             If .Col > Qslz Then
  1388.                 KeyCode = 0
  1389.                 .SetFocus
  1390.                 Call Lrsjhx
  1391.                 Coljsq = .Col - 1
  1392.                 Do While Coljsq > Qslz
  1393.                     If Coljsq - 1 = Qslz Then
  1394.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1395.                             GoTo jzzx
  1396.                         End If
  1397.                     End If
  1398.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1399.                         Coljsq = Coljsq - 1
  1400.                     Else
  1401.                         Exit Do
  1402.                     End If
  1403.                 Loop
  1404.                 .Select .Row, Coljsq
  1405.             End If
  1406.             
  1407.         Case vbKeyRight                 '右 箭 头 =39
  1408.             KeyCode = 0
  1409.             .SetFocus
  1410.             Call Lrsjhx
  1411.             Rowjsq = .Row
  1412.             Coljsq = .Col + 1
  1413.             If Coljsq > .Cols - 1 Then
  1414.                 If Rowjsq < .Rows - 1 Then
  1415.                     Rowjsq = Rowjsq + 1
  1416.                 End If
  1417.                 Coljsq = Qslz
  1418.             End If
  1419.             Do While Rowjsq <= .Rows - 1
  1420.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1421.                     Coljsq = Coljsq + 1
  1422.                     If Coljsq > .Cols - 1 Then
  1423.                         Rowjsq = Rowjsq + 1
  1424.                         Coljsq = Qslz
  1425.                     End If
  1426.                 Else
  1427.                     Exit Do
  1428.                 End If
  1429.             Loop
  1430.             .Select Rowjsq, Coljsq
  1431.         Case Else
  1432.         End Select
  1433.         
  1434. jzzx:
  1435.     End With
  1436. End Sub
  1437. Private Sub YdCombo_LostFocus()
  1438.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1439.         If Not Valilock Then                           '为TRUE
  1440.             Call Lrsjhx
  1441.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1442.                 Exit Sub
  1443.             End If
  1444.         End If
  1445.     End With
  1446. End Sub
  1447. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1448.     Call Lrzdbz
  1449. End Sub
  1450. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1451.     Dim Rowjsq As Long, Coljsq As Long
  1452.     With WglrGrid
  1453.         Select Case KeyCode
  1454.         Case vbKeyF2
  1455.             Call Lrzdbz
  1456.         Case vbKeyEscape                'ESC 键放弃录入
  1457.             Valilock = True
  1458.             Call Ycwbk
  1459.             .SetFocus
  1460.         Case vbKeyReturn                '回 车 键 =13
  1461.             KeyCode = 0
  1462.             .SetFocus
  1463.             Call Lrsjhx
  1464.             Rowjsq = .Row
  1465.             Coljsq = .Col + 1
  1466.             If Coljsq > .Cols - 1 Then
  1467.                 If Rowjsq < .Rows - 1 Then
  1468.                     Rowjsq = Rowjsq + 1
  1469.                 End If
  1470.                 Coljsq = Qslz
  1471.             End If
  1472.             Do While Rowjsq <= .Rows - 1
  1473.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1474.                     Coljsq = Coljsq + 1
  1475.                     If Coljsq > .Cols - 1 Then
  1476.                         Rowjsq = Rowjsq + 1
  1477.                         Coljsq = Qslz
  1478.                     End If
  1479.                 Else
  1480.                     Exit Do
  1481.                 End If
  1482.             Loop
  1483.             .Select Rowjsq, Coljsq
  1484.         Case vbKeyUp                    '上 箭 头 =38
  1485.             KeyCode = 0
  1486.             .SetFocus
  1487.             Call Lrsjhx
  1488.             If .Row > .FixedRows Then
  1489.                 .Row = .Row - 1
  1490.             End If
  1491.         Case vbKeyDown                  '下 箭 头 =40
  1492.             KeyCode = 0
  1493.             .SetFocus
  1494.             Call Lrsjhx
  1495.             If .Row < .Rows - 1 Then
  1496.                 .Row = .Row + 1
  1497.             End If
  1498.         Case vbKeyLeft                  '左 箭 头 =37
  1499.             If .Col - 1 = Qslz Then
  1500.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1501.                     GoTo jzzx
  1502.                 End If
  1503.             End If
  1504.             If Ydtext.SelStart = 0 And .Col > Qslz Then
  1505.                 KeyCode = 0
  1506.                 .SetFocus
  1507.                 Call Lrsjhx
  1508.                 Coljsq = .Col - 1
  1509.                 Do While Coljsq > Qslz
  1510.                     If Coljsq - 1 = Qslz Then
  1511.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1512.                             GoTo jzzx
  1513.                         End If
  1514.                     End If
  1515.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1516.                         Coljsq = Coljsq - 1
  1517.                     Else
  1518.                         Exit Do
  1519.                     End If
  1520.                 Loop
  1521.                 .Select .Row, Coljsq
  1522.             End If
  1523. jzzx:
  1524.         Case vbKeyRight                 '右 箭 头 =39
  1525.             wblong = Len(Ydtext.Text)
  1526.             If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1527.                 KeyCode = 0
  1528.                 .SetFocus
  1529.                 Call Lrsjhx
  1530.                 Rowjsq = .Row
  1531.                 Coljsq = .Col + 1
  1532.                 If Coljsq > .Cols - 1 Then
  1533.                     If Rowjsq < .Rows - 1 Then
  1534.                         Rowjsq = Rowjsq + 1
  1535.                     End If
  1536.                     Coljsq = Qslz
  1537.                 End If
  1538.                 Do While Rowjsq <= .Rows - 1
  1539.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1540.                         Coljsq = Coljsq + 1
  1541.                         If Coljsq > .Cols - 1 Then
  1542.                             Rowjsq = Rowjsq + 1
  1543.                             Coljsq = Qslz
  1544.                         End If
  1545.                     Else
  1546.                         Exit Do
  1547.                     End If
  1548.                 Loop
  1549.                 .Select Rowjsq, Coljsq
  1550.             End If
  1551.         Case Else
  1552.         End Select
  1553.     End With
  1554. End Sub
  1555. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1556.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1557.     If KeyAscii <> 0 Then
  1558.         Call Xyxhbz(Dqlrwgh)
  1559.     End If
  1560. End Sub
  1561. Private Sub ydtext_Change()                              '录入事中变化处理
  1562.     
  1563.     '防止程序改变但不进行处理
  1564.     
  1565.     If Wbkbhlock Then
  1566.         Exit Sub
  1567.     End If
  1568.     
  1569.     With WglrGrid
  1570.         
  1571.         '限制字段录入长度
  1572.         Wbkbhlock = True
  1573.         Select Case GridInt(.Col, 1)
  1574.         Case 8
  1575.             Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1576.         Case 9
  1577.             Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1578.         Case 10
  1579.             Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1580.         Case Else
  1581.             If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1582.                 Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1583.             End If
  1584.         End Select
  1585.         Wbkbhlock = False
  1586.     End With
  1587. End Sub
  1588. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1589.     With WglrGrid
  1590.         If Not Valilock Then
  1591.             Call Lrsjhx
  1592.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1593.                 Exit Sub
  1594.             End If
  1595.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1596.                 Exit Sub
  1597.             End If
  1598.         End If
  1599.     End With
  1600. End Sub
  1601. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1602.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1603.     
  1604.     '如果单据操作状态为浏览状态则不能显示录入载体
  1605.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1606.         Exit Sub
  1607.     End If
  1608.     
  1609.     '显示文本框前返回有效行列(解决滚动条问题)
  1610.     Call Xldqh
  1611.     Call Xldql
  1612.     
  1613.     '隐藏文本框,帮助按钮,列表组合框
  1614.     Call Ycwbk
  1615.     
  1616.     With WglrGrid
  1617.         Dqlrwgh = .Row
  1618.         Dqlrwgl = .Col
  1619.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1620.             Exit Sub
  1621.         End If
  1622.         
  1623.         Wbkpy = 30
  1624.         Wbkpy1 = 15
  1625.         
  1626.         If GridBoolean(.Col, 3) Then
  1627.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1628.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1629.             YdCombo.Width = .CellWidth - Wbkpy1
  1630.             Call Wbkcl
  1631.             YdCombo.Visible = True
  1632.             YdCombo.SetFocus
  1633.             Ydcommand.Visible = False
  1634.             Ydtext.Visible = False
  1635.         Else
  1636.             If GridBoolean(.Col, 2) Then
  1637.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1638.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1639.                 Ydcommand.Visible = True
  1640.             Else
  1641.                 Ydcommand.Visible = False
  1642.             End If
  1643.             
  1644.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1645.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1646.             If Ydcommand.Visible Then
  1647.                 If Sfblbzkd Then
  1648.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1649.                 Else
  1650.                     Ydtext.Width = .CellWidth - Wbkpy1
  1651.                 End If
  1652.             Else
  1653.                 Ydtext.Width = .CellWidth - Wbkpy1
  1654.             End If
  1655.             Ydtext.Height = .CellHeight - Wbkpy1
  1656.             
  1657.             If GridInt(.Col, 2) <> 0 Then
  1658.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1659.             Else
  1660.                 Ydtext.MaxLength = 3000
  1661.             End If
  1662.             
  1663.             Call Wbkcl
  1664.             
  1665.             Ydtext.Visible = True
  1666.             Ydtext.SetFocus
  1667.         End If
  1668.         Dqtoprow = .TopRow
  1669.         Dqleftcol = .LeftCol
  1670.         
  1671.         '重置锁值
  1672.         Valilock = False
  1673.         Wbkbhlock = False
  1674.     End With
  1675. End Sub
  1676. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1677.     
  1678.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1679.     Wbkpy = 30
  1680.     Wbkpy1 = 15
  1681.     With WglrGrid
  1682.         If YdCombo.Visible Then
  1683.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1684.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1685.             YdCombo.Width = .CellWidth - Wbkpy1
  1686.         End If
  1687.         If Ydcommand.Visible Then
  1688.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1689.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1690.         End If
  1691.         If Ydtext.Visible Then
  1692.             If Ydcommand.Visible Then
  1693.                 If Sfblbzkd Then
  1694.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1695.                 Else
  1696.                     Ydtext.Width = .CellWidth - Wbkpy1
  1697.                 End If
  1698.             Else
  1699.                 Ydtext.Width = .CellWidth - Wbkpy1
  1700.             End If
  1701.             
  1702.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1703.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1704.             Ydtext.Height = .CellHeight - Wbkpy1
  1705.         End If
  1706.     End With
  1707.     
  1708. End Sub
  1709. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1710.     With WglrGrid
  1711.         If YdCombo.Visible Then
  1712.             .Text = Trim(YdCombo.Text)
  1713.         End If
  1714.         If Ydtext.Visible Then
  1715.             .Text = Trim(Ydtext.Text)
  1716.         End If
  1717.         
  1718.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1719.         If Zdlrqnr <> Trim(.Text) Then
  1720.             Yxxpdlock = False
  1721.             Hyxxpdlock = False
  1722.         End If
  1723.         
  1724.         '如果字段录入内容不为空则写数据行有效性标志
  1725.         
  1726.         If Len(Trim(.Text)) <> 0 Then
  1727.             Call Xyxhbz(.Row)
  1728.         End If
  1729.         
  1730.         '隐藏文本框,帮助按钮,列表组合框
  1731.         Call Ycwbk
  1732.         
  1733.     End With
  1734. End Sub
  1735. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行,删行快捷键
  1736.     
  1737.     '如果单据操作状态为浏览状态则不能显示录入载体
  1738.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1739.         Exit Sub
  1740.     End If
  1741.     
  1742.     Select Case KeyCode
  1743.     Case vbKeyDelete               '删行
  1744.         Call Scdqfl
  1745.     Case vbKeyInsert               '增行
  1746.         Call zjlrfl
  1747.     End Select
  1748. End Sub
  1749. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                     '网格接受键盘录入
  1750.     Dim Str_ChangeTe As String    '临时交换内容
  1751.     Dim Coljsq As Long            '临时列计数器
  1752.     Dim Int_SaveKey As Integer    '保存KeyAscii值
  1753.     
  1754.     '如果单据操作状态为浏览状态则不能显示录入载体
  1755.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1756.         Exit Sub
  1757.     End If
  1758.     
  1759.     Int_SaveKey = KeyAscii
  1760.     
  1761.     With WglrGrid
  1762.         '屏 蔽 回 车 键
  1763.         If KeyAscii = vbKeyReturn Then
  1764.             KeyAscii = 0
  1765.             Rowjsq = .Row
  1766.             Coljsq = .Col + 1
  1767.             If Coljsq > .Cols - 1 Then
  1768.                 If Rowjsq < .Rows - 1 Then
  1769.                     Rowjsq = Rowjsq + 1
  1770.                 End If
  1771.                 Coljsq = Qslz
  1772.             End If
  1773.             Do While Rowjsq <= .Rows - 1
  1774.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1775.                     Coljsq = Coljsq + 1
  1776.                     If Coljsq > .Cols - 1 Then
  1777.                         Rowjsq = Rowjsq + 1
  1778.                         Coljsq = Qslz
  1779.                     End If
  1780.                 Else
  1781.                     Exit Do
  1782.                 End If
  1783.             Loop
  1784.             .Select Rowjsq, Coljsq
  1785.             Exit Sub
  1786.         End If
  1787.         '接受用户录入
  1788.         Select Case KeyAscii
  1789.         Case 0 To 32
  1790.             
  1791.             '[>>开始 当用户输入空格时,如果在摘要列则自动填入上条记录录入的摘要内容
  1792.             ' 如果在金额列则交换借贷内容,此段程序不要求有效性判断,否则应另行处理
  1793.             Select Case GridStr(.Col, 1)
  1794.             Case "001"   '摘要
  1795.                 If Len(Trim(WglrGrid.TextMatrix(.Row, .Col))) = 0 And Len(Trim(Str_Digest)) <> 0 Then
  1796.                     
  1797.                     WglrGrid.TextMatrix(.Row, .Col) = Str_Digest
  1798.                     
  1799.                     '写有效行数据标志,并打开行有效性判断锁
  1800.                     Call Xyxhbz(.Row)
  1801.                     Hyxxpdlock = False
  1802.                 End If
  1803.             Case "004", "005"  '借方金额,贷方金额
  1804.                 If Val(WglrGrid.TextMatrix(.Row, .Col)) = 0 Then
  1805.                     Str_ChangeTe = WglrGrid.TextMatrix(.Row, Sydz("004", GridStr(), Szzls))
  1806.                     
  1807.                     WglrGrid.TextMatrix(.Row, Sydz("004", GridStr(), Szzls)) = WglrGrid.TextMatrix(.Row, Sydz("005", GridStr(), Szzls))
  1808.                     
  1809.                     WglrGrid.TextMatrix(.Row, Sydz("005", GridStr(), Szzls)) = Str_ChangeTe
  1810.                     
  1811.                     '写有效行数据标志,并打开行有效性判断锁
  1812.                     Call Xyxhbz(.Row)
  1813.                     Hyxxpdlock = False
  1814.                     
  1815.                     '计算合计数据
  1816.                     For Coljsq = Qslz To .Cols - 1
  1817.                         Call Sjhj(Coljsq)
  1818.                     Next Coljsq
  1819.                 End If
  1820.             End Select
  1821.             
  1822.             '完毕<<]
  1823.             
  1824.             
  1825.             '显示录入载体
  1826.             Call xswbk
  1827.             
  1828.         Case Else
  1829.             
  1830.             '防止非编辑字段SendKeys()出现死循环
  1831.             If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1832.                 Exit Sub
  1833.             End If
  1834.             
  1835.             If GridBoolean(.Col, 3) Then
  1836.                 
  1837.                 '列表框录入
  1838.                 Call xswbk
  1839.                 
  1840.             Else
  1841.                 
  1842.                 '[>>开始 如果用户在借贷金额位置按"="且当前行金额为零则自动计算借贷合计差额填入录入文本框
  1843.                 If Chr(KeyAscii) = "=" And (Val(.TextMatrix(.Row, Sydz("004", GridStr(), Szzls))) = 0 And Val(.TextMatrix(.Row, Sydz("005", GridStr(), Szzls))) = 0) Then
  1844.                     Select Case GridStr(.Col, 1)
  1845.                     Case "004"   '借方金额
  1846.                         Ydtext.Text = ""
  1847.                         Call Xyxhbz(.Row)
  1848.                         Call xswbk
  1849.                         Ydtext.Text = Format(Val(HjGrid.TextMatrix(0, Sydz("005", GridStr(), Szzls))) - Val(HjGrid.TextMatrix(0, .Col)), "##." + String(Xtjexsws, "0"))
  1850.                     Case "005"   '贷方金额
  1851.                         Ydtext.Text = ""
  1852.                         Call Xyxhbz(.Row)
  1853.                         Call xswbk
  1854.                         Ydtext.Text = Format(Val(HjGrid.TextMatrix(0, Sydz("004", GridStr(), Szzls))) - Val(HjGrid.TextMatrix(0, .Col)), "##." + String(Xtjexsws, "0"))
  1855.                         
  1856.                     End Select
  1857.                     
  1858.                     '完毕<<]
  1859.                 Else
  1860.                     
  1861.                     Ydtext.Text = ""
  1862.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1863.                     If KeyAscii = 0 Then
  1864.                         Exit Sub
  1865.                     End If
  1866.                     
  1867.                     '写有效行数据标志
  1868.                     Call Xyxhbz(.Row)
  1869.                     Call xswbk
  1870.                     Ydtext.Text = ""
  1871.                     Valilock = True
  1872.                     SendKeys Chr(KeyAscii), wait
  1873.                     DoEvents
  1874.                     Valilock = False
  1875.                 End If
  1876.                 
  1877.             End If
  1878.         End Select
  1879.     End With
  1880. End Sub
  1881. Private Sub zjlrfl()                                                    '增加录入分录
  1882.     
  1883.     '判断当前凭证是否允许修改
  1884.     
  1885.     With WglrGrid
  1886.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1887.             If Not Fun_Drfrmyxxpd Then
  1888.                 Exit Sub
  1889.             End If
  1890.         Else
  1891.             Exit Sub
  1892.         End If
  1893.         If .Row < .FixedRows Then
  1894.             Exit Sub
  1895.         End If
  1896.         .AddItem "", .Row
  1897.         .RowHeight(.Row) = Sjhgd
  1898.         If .Row <> .Rows - 1 Then
  1899.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1900.                 .TextMatrix(.Row, 0) = "*"
  1901.             Else
  1902.                 .RemoveItem .Rows - 1
  1903.             End If
  1904.         End If
  1905.         Call Xldqh
  1906.         Call Xldql
  1907.         Hyxxpdlock = False
  1908.     End With
  1909. End Sub
  1910. Private Sub Scdqfl()                                                    '删除当前分录
  1911.     '判断当前凭证是否允许修改
  1912.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
  1913.     With WglrGrid
  1914.         Scqwghz = .Row
  1915.         Scqwglz = .Col
  1916.         If .TextMatrix(.Row, 0) = "*" Then
  1917.             
  1918.             '判断是否为录入状态
  1919.             If Ydtext.Visible Or YdCombo.Visible Then
  1920.                 Sflrzt = True
  1921.                 Validate = True
  1922.                 Call Lrsjhx
  1923.                 Validate = False
  1924.             End If
  1925.             
  1926.             Call Xldqh
  1927.             changelock = True
  1928.             .Select .Row, 0
  1929.             changelock = False
  1930.             If Shsfts Then
  1931.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1932.                 Tsxx = "请确认是否删除当前记录?"
  1933.                 yhAnswer = Xtxxts(Tsxx, 2, 2)
  1934.                 If yhAnswer = 2 Then
  1935.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1936.                     changelock = True
  1937.                     .Select Scqwghz, Scqwglz
  1938.                     changelock = False
  1939.                     
  1940.                     '如为录入状态,则恢复录入
  1941.                     If Sflrzt Then
  1942.                         Call xswbk
  1943.                     End If
  1944.                     
  1945.                     Exit Sub
  1946.                 End If
  1947.             End If
  1948.             .RemoveItem .Row
  1949.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1950.                 .AddItem ""
  1951.                 .RowHeight(.Rows - 1) = Sjhgd
  1952.             End If
  1953.             changelock = True
  1954.             .Select .Row, Scqwglz
  1955.             changelock = False
  1956.             
  1957.             '重新计算合计数据
  1958.             For Hjlzte = Qslz To .Cols - 1
  1959.                 Call Sjhj(Hjlzte)
  1960.             Next Hjlzte
  1961.             
  1962.         End If
  1963.     End With
  1964. End Sub
  1965. Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
  1966.     Dim Hjjg As Double
  1967.     If Not (GridBoolean(Hjwgl, 4) And HjGrid.Visible) Then
  1968.         Exit Sub
  1969.     End If
  1970.     With WglrGrid
  1971.         Hjjg = 0
  1972.         For jsqte = .FixedRows To .Rows - 1
  1973.             If .TextMatrix(jsqte, 0) = "*" Then
  1974.                 Hjjg = Hjjg + Val(.TextMatrix(jsqte, Hjwgl))
  1975.             End If
  1976.         Next jsqte
  1977.         If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
  1978.             HjGrid.TextMatrix(0, Hjwgl) = ""
  1979.         Else
  1980.             HjGrid.TextMatrix(0, Hjwgl) = Hjjg
  1981.         End If
  1982.     End With
  1983. End Sub
  1984. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1985.     If Not GridBoolean(Sjl, 5) Then
  1986.         Exit Sub
  1987.     End If
  1988.     With WglrGrid
  1989.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1990.             .TextMatrix(sjh, Sjl) = ""
  1991.         End If
  1992.     End With
  1993. End Sub
  1994. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1995.     With WglrGrid
  1996.         If .Row >= .FixedRows Then
  1997.             If .TextMatrix(.Row, 0) <> "*" Then
  1998.                 For Rowjsq = .FixedRows To .Rows - 1
  1999.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  2000.                         Exit For
  2001.                     End If
  2002.                 Next Rowjsq
  2003.                 If Rowjsq <= .Rows - 1 Then
  2004.                     changelock = True
  2005.                     .Select Rowjsq, .Col
  2006.                     changelock = False
  2007.                 Else
  2008.                     changelock = True
  2009.                     .Select .Rows - 1, .Col
  2010.                     changelock = False
  2011.                 End If
  2012.             End If
  2013.             Call Xldqh
  2014.         End If
  2015.     End With
  2016. End Sub
  2017. Private Sub Xldqh()                                                      '显露当前行
  2018.     Dim Toprowte As Long
  2019.     With WglrGrid
  2020.         Toprowte = 0
  2021.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  2022.             Toprowte = .TopRow
  2023.             .TopRow = .TopRow + 1
  2024.         Loop
  2025.         Toprowte = 0
  2026.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  2027.             Toprowte = .TopRow
  2028.             .TopRow = .TopRow - 1
  2029.         Loop
  2030.     End With
  2031. End Sub
  2032. Private Sub Xldql()                                                     '显露当前列
  2033.     Dim Leftcolte As Long
  2034.     With WglrGrid
  2035.         If .Col >= Qslz Then
  2036.             If .LeftCol > .Col Then
  2037.                 .LeftCol = .Col
  2038.             End If
  2039.             Leftcolte = 0
  2040.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  2041.                 Leftcolte = .LeftCol
  2042.                 .LeftCol = .LeftCol + 1
  2043.             Loop
  2044.         End If
  2045.     End With
  2046. End Sub
  2047. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  2048.     With WglrGrid
  2049.         For Coljsq = Qslz To .Cols - 1
  2050.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  2051.                 pdhwk = False
  2052.                 Exit Function
  2053.             End If
  2054.         Next Coljsq
  2055.         pdhwk = True
  2056.     End With
  2057. End Function
  2058. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  2059.     With WglrGrid
  2060.         If .TextMatrix(sjh, 0) = "*" Then
  2061.             Exit Sub
  2062.         End If
  2063.         .TextMatrix(sjh, 0) = "*"
  2064.         If sjh >= .Rows - Fzxwghs - 1 Then
  2065.             .AddItem ""
  2066.             .RowHeight(.Rows - 1) = Sjhgd
  2067.         End If
  2068.     End With
  2069. End Sub
  2070. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  2071.     Select Case Button.Key
  2072.     Case "bcgs"                              '保存表格格式
  2073.         Call Bcwggs(WglrGrid, GridCode, GridStr)
  2074.     Case "hfmrgs"                            '恢复默认格式
  2075.         Call Hfmrgs(WglrGrid, GridCode, GridStr)
  2076.     End Select
  2077. End Sub
  2078. Private Sub bbyl(bbylte As Boolean)                                     '打印预览(通用)
  2079.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  2080.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  2081.     Bbxbtgs = 1                                  '报 表 小 标 题 行 数
  2082.     Bbbwhgs = 1                                  '报 表 表 尾 行 数
  2083.     ReDim Bbxbt(1 To Bbxbtgs)
  2084.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  2085.     If Bbbwhgs <> 0 Then
  2086.         ReDim Bbbwh(1 To Bbbwhgs)
  2087.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  2088.     End If
  2089.     Bbzbt = ReportTitle
  2090.     
  2091.     Bbxbt(1) = Space(45) + Fun_FormatOutPut("制单日期:" + Trim(LrText(1).Text), 30)
  2092.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("凭证字号:" + Trim(LrText(0).Text) + "-" + Trim(LrText(3).Text), 26)
  2093.     Bbbwh(1) = Fun_FormatOutPut("会计主管:", 18) + Fun_FormatOutPut("记帐:" + Lab_Book, 18)
  2094.     Bbbwh(1) = Bbbwh(1) + Fun_FormatOutPut("出纳:", 18) + Fun_FormatOutPut("审核:" + Lab_Checker, 18)
  2095.     Bbbwh(1) = Bbbwh(1) + Fun_FormatOutPut("制单:" + Lab_Bill, 18) + Trim(Fun_FormatOutPut("附单据数:" + Trim(LrText(2).Text), 23))
  2096.     
  2097.     bbxbtzzxs(1) = 0                             '报表行组织形式(0-居左 1-居中 2-居右)
  2098.     Bbbwhzzxs(1) = 1
  2099.     Call Sub_Scpzbb(WglrGrid)                    '生成报表数据(自定义程序)
  2100.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  2101.     If Not bbylte Then
  2102.         Unload DY_Tybbyldy
  2103.     End If
  2104. End Sub
  2105. '************以下为文本框录入处理程序(固定不变部分)*************'
  2106. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  2107.     
  2108.     '以下为依据实际情况自定义部分[
  2109.     
  2110.     '在此填写文本框录入事后处理程序
  2111.     
  2112.     ']以上为依据实际情况自定义部分
  2113. End Sub
  2114. Private Sub LrText_Change(Index As Integer)
  2115.     
  2116.     '屏蔽程序改变控制
  2117.     If TextChangeLock Then
  2118.         Exit Sub
  2119.     End If
  2120.     
  2121.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  2122.     
  2123.     '限制字段录入长度
  2124.     
  2125.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  2126.     Select Case Textint(Index, 1)
  2127.     Case 8           '金额型
  2128.         Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  2129.     Case 9           '数量型
  2130.         Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  2131.     Case 10          '单价型
  2132.         Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  2133.     Case Else        '其他小数类型控制
  2134.         If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  2135.             Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  2136.         End If
  2137.     End Select
  2138.     
  2139.     '[>>随时计算最新单据号
  2140.     If Index = 0 Then
  2141.         Call Sub_JsVouchNo
  2142.     End If
  2143.     '<<]
  2144.     
  2145.     TextChangeLock = False '解锁
  2146.     
  2147. End Sub
  2148. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  2149.     Call TextShow(Index)
  2150. End Sub
  2151. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  2152.     Select Case KeyCode
  2153.     Case vbKeyF2
  2154.         Call Text_Help(Index)
  2155.     End Select
  2156. End Sub
  2157. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  2158.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  2159. End Sub
  2160. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  2161.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  2162.         Call TextYxxpd(Index)
  2163.     End If
  2164. End Sub
  2165. Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  2166.     Call Text_Help(Ydcommand1.Tag)
  2167. End Sub
  2168. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  2169.     If Not Ydcommand1.Visible Then
  2170.         Exit Sub
  2171.     End If
  2172.     TextValiLock = True
  2173.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  2174.     If Len(Xtfhcs) <> 0 Then
  2175.         If Textint(Index, 3) = 1 Then
  2176.             LrText(Index).Text = Xtfhcsfz
  2177.             LrText(Index).Tag = Xtfhcs
  2178.         Else
  2179.             LrText(Index).Text = Xtfhcs
  2180.             LrText(Index).Tag = Xtfhcsfz
  2181.         End If
  2182.         
  2183.     End If
  2184.     TextValiLock = False
  2185.     '   LrText(Index).SetFocus
  2186. End Sub
  2187. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  2188.     If Textboolean(Index, 1) Then
  2189.         Ydcommand1.Visible = True
  2190.         Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
  2191.         Ydcommand1.Tag = Index
  2192.     Else
  2193.         Ydcommand1.Tag = ""
  2194.         Ydcommand1.Visible = False
  2195.     End If
  2196. End Sub
  2197. Private Sub Wbkcsh()                          '录入文本框初始化
  2198.     
  2199.     '最大录入文本框索引值
  2200.     Max_Text_Index = Textvar(1)
  2201.     
  2202.     ReDim TextValiJudgeLock(Max_Text_Index)
  2203.     For jsqte = 0 To Max_Text_Index
  2204.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  2205.             TextChangeLock = True
  2206.             LrText(jsqte).Text = ""
  2207.             LrText(jsqte).Tag = ""
  2208.             If Textint(jsqte, 5) <> 0 Then
  2209.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  2210.             End If
  2211.             TextChangeLock = False
  2212.         End If
  2213.         TextValiJudgeLock(jsqte) = True
  2214.     Next jsqte
  2215. End Sub
  2216. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  2217.     Dim Sqlstr As String
  2218.     Dim Findrec As New ADODB.Recordset
  2219.     
  2220.     '按帮助不进行有效性判断
  2221.     
  2222.     If TextValiLock Then
  2223.         TextValiLock = False
  2224.         TextYxxpd = True
  2225.         Exit Function
  2226.     End If
  2227.     
  2228.     '文本框内容未曾改变不进行有效性判断
  2229.     
  2230.     If TextValiJudgeLock(Index) Then
  2231.         Ydcommand1.Visible = False
  2232.         TextYxxpd = True
  2233.         Exit Function
  2234.     End If
  2235.     If Trim(LrText(Index)) = "" Then
  2236.         LrText(Index).Tag = ""
  2237.         Call Wbklrwbcl(Index)
  2238.         Ydcommand1.Visible = False
  2239.         TextValiJudgeLock(Index) = True
  2240.         TextYxxpd = True
  2241.         
  2242.         '[>>如果凭证类别清空,则字号应清空
  2243.         If Index = 0 Then
  2244.             TextChangeLock = True
  2245.             LrText(3).Text = ""
  2246.             TextChangeLock = False
  2247.         End If
  2248.         '<<]
  2249.         
  2250.         Exit Function
  2251.     End If
  2252.     Select Case Textint(Index, 4)
  2253.     Case 1      '编码型
  2254.         Sqlstr = Trim(Textstr(Index, 5))
  2255.         Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  2256.         Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  2257.         If Findrec.EOF Then
  2258.             Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  2259.             LrText(Index).SetFocus
  2260.             Exit Function
  2261.         Else
  2262.             Select Case Textint(Index, 3)
  2263.             Case 0
  2264.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  2265.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  2266.                 End If
  2267.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  2268.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  2269.                 End If
  2270.             Case 1
  2271.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  2272.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  2273.                 End If
  2274.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  2275.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  2276.                 End If
  2277.             End Select
  2278.         End If
  2279.         
  2280.         '[>>凭证类别如有效,且内容已经发生改变则自动计算类别字号
  2281.         If Index = 0 Then
  2282.             Call Sub_JsVouchNo
  2283.         End If
  2284.         '<<]
  2285.         
  2286.     Case 2      '日期型
  2287.         If IsDate(LrText(Index).Text) Then
  2288.             LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  2289.         Else
  2290.             Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  2291.             Call Xtxxts(Tsxx, 0, 1)
  2292.            ' LrText(Index).SetFocus
  2293.             Exit Function
  2294.         End If
  2295.     Case 3      '其他类型
  2296.     End Select
  2297.     Ydcommand1.Visible = False
  2298.     TextValiJudgeLock(Index) = True
  2299.     TextYxxpd = True
  2300. End Function