开通博客赚积分
发布资源赚积分
分类

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