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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 企业管理 > 查看源码
资源名称：ERPSYS.zip　[点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：172k
源码类别：

企业管理

开发平台：

Visual Basic

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