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

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

企业管理

开发平台：

Visual Basic

：源码内容
  1. VERSION 5.00
  2. Object = "{65A39231-6133-11D1-BAA2-444553540000}#1.0#0"; "vslight6.OCX"
  3. Object = "{C5DE3F80-3376-11D2-BAA4-04F205C10000}#1.0#0"; "Vsflex6d.ocx"
  4. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  5. Begin VB.Form JZ_FrmTranList 
  6.    Caption         =   "结转生产成本"
  7.    ClientHeight    =   6225
  8.    ClientLeft      =   60
  9.    ClientTop       =   345
  10.    ClientWidth     =   9240
  11.    Icon            =   "结转凭证_成本结转.frx":0000
  12.    KeyPreview      =   -1  'True
  13.    LinkTopic       =   "Form4"
  14.    ScaleHeight     =   6225
  15.    ScaleWidth      =   9240
  16.    StartUpPosition =   2  '屏幕中心
  17.    Begin VB.PictureBox Pic_Title 
  18.       AutoRedraw      =   -1  'True
  19.       Height          =   1155
  20.       Left            =   0
  21.       Picture         =   "结转凭证_成本结转.frx":1042
  22.       ScaleHeight     =   1095
  23.       ScaleMode       =   0  'User
  24.       ScaleWidth      =   9264.57
  25.       TabIndex        =   1
  26.       Top             =   570
  27.       Width           =   9245
  28.       Begin VB.ComboBox Combo_KJQJ 
  29.          Height          =   300
  30.          Left            =   1620
  31.          Style           =   2  'Dropdown List
  32.          TabIndex        =   8
  33.          Top             =   750
  34.          Width           =   2025
  35.       End
  36.       Begin MSComctlLib.ImageList ImageList1 
  37.          Left            =   6840
  38.          Top             =   30
  39.          _ExtentX        =   1005
  40.          _ExtentY        =   1005
  41.          BackColor       =   -2147483643
  42.          ImageWidth      =   16
  43.          ImageHeight     =   16
  44.          MaskColor       =   12632256
  45.          _Version        =   393216
  46.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  47.             NumListImages   =   22
  48.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  49.                Picture         =   "结转凭证_成本结转.frx":35106
  50.                Key             =   "sz"
  51.             EndProperty
  52.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  53.                Picture         =   "结转凭证_成本结转.frx":354A0
  54.                Key             =   "dy"
  55.             EndProperty
  56.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  57.                Picture         =   "结转凭证_成本结转.frx":3583A
  58.                Key             =   "yl"
  59.             EndProperty
  60.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  61.                Picture         =   "结转凭证_成本结转.frx":35BD4
  62.                Key             =   "xg"
  63.             EndProperty
  64.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  65.                Picture         =   "结转凭证_成本结转.frx":35F6E
  66.                Key             =   "zh"
  67.             EndProperty
  68.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  69.                Picture         =   "结转凭证_成本结转.frx":36308
  70.                Key             =   "sh"
  71.             EndProperty
  72.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  73.                Picture         =   "结转凭证_成本结转.frx":366A2
  74.                Key             =   "bc"
  75.             EndProperty
  76.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  77.                Picture         =   "结转凭证_成本结转.frx":36A3C
  78.                Key             =   "fq"
  79.             EndProperty
  80.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  81.                Picture         =   "结转凭证_成本结转.frx":36DD6
  82.                Key             =   "bz"
  83.             EndProperty
  84.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  85.                Picture         =   "结转凭证_成本结转.frx":37170
  86.                Key             =   "tc"
  87.             EndProperty
  88.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  89.                Picture         =   "结转凭证_成本结转.frx":3750A
  90.                Key             =   "bcgs"
  91.             EndProperty
  92.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  93.                Picture         =   "结转凭证_成本结转.frx":378A4
  94.                Key             =   "mrlk"
  95.             EndProperty
  96.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  97.                Picture         =   "结转凭证_成本结转.frx":37C3E
  98.                Key             =   "xsxm"
  99.             EndProperty
  100.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  101.                Picture         =   "结转凭证_成本结转.frx":37FD8
  102.                Key             =   "first"
  103.             EndProperty
  104.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  105.                Picture         =   "结转凭证_成本结转.frx":38372
  106.                Key             =   "prev"
  107.             EndProperty
  108.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  109.                Picture         =   "结转凭证_成本结转.frx":3870C
  110.                Key             =   "next"
  111.             EndProperty
  112.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  113.                Picture         =   "结转凭证_成本结转.frx":38AA6
  114.                Key             =   "last"
  115.             EndProperty
  116.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  117.                Picture         =   "结转凭证_成本结转.frx":38E40
  118.                Key             =   "xx"
  119.             EndProperty
  120.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  121.                Picture         =   "结转凭证_成本结转.frx":391DA
  122.                Key             =   "define"
  123.             EndProperty
  124.             BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  125.                Picture         =   "结转凭证_成本结转.frx":39574
  126.                Key             =   "exec"
  127.             EndProperty
  128.             BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  129.                Picture         =   "结转凭证_成本结转.frx":3990E
  130.                Key             =   "xz"
  131.             EndProperty
  132.             BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  133.                Picture         =   "结转凭证_成本结转.frx":39CA8
  134.                Key             =   "sc"
  135.             EndProperty
  136.          EndProperty
  137.       End
  138.       Begin VB.Label tsLabel 
  139.          AutoSize        =   -1  'True
  140.          BackColor       =   &H80000018&
  141.          BackStyle       =   0  'Transparent
  142.          Caption         =   "结转生产成本"
  143.          BeginProperty Font 
  144.             Name            =   "宋体"
  145.             Size            =   14.25
  146.             Charset         =   134
  147.             Weight          =   700
  148.             Underline       =   0   'False
  149.             Italic          =   0   'False
  150.             Strikethrough   =   0   'False
  151.          EndProperty
  152.          ForeColor       =   &H00000000&
  153.          Height          =   285
  154.          Index           =   6
  155.          Left            =   360
  156.          TabIndex        =   7
  157.          Top             =   240
  158.          Width           =   1800
  159.       End
  160.       Begin VB.Label tsLabel 
  161.          AutoSize        =   -1  'True
  162.          BackStyle       =   0  'Transparent
  163.          Caption         =   "当前记录"
  164.          Height          =   180
  165.          Index           =   13
  166.          Left            =   7350
  167.          TabIndex        =   6
  168.          Top             =   810
  169.          Width           =   720
  170.       End
  171.       Begin VB.Label tsLabel 
  172.          AutoSize        =   -1  'True
  173.          BackStyle       =   0  'Transparent
  174.          Caption         =   "行)"
  175.          Height          =   180
  176.          Index           =   12
  177.          Left            =   8775
  178.          TabIndex        =   5
  179.          Top             =   810
  180.          Width           =   270
  181.       End
  182.       Begin VB.Label tsLabel 
  183.          AutoSize        =   -1  'True
  184.          BackStyle       =   0  'Transparent
  185.          Caption         =   "(第"
  186.          Height          =   180
  187.          Index           =   11
  188.          Left            =   8160
  189.          TabIndex        =   4
  190.          Top             =   810
  191.          Width           =   270
  192.       End
  193.       Begin VB.Label Lab_Row 
  194.          Alignment       =   2  'Center
  195.          Appearance      =   0  'Flat
  196.          AutoSize        =   -1  'True
  197.          BackColor       =   &H80000005&
  198.          BackStyle       =   0  'Transparent
  199.          ForeColor       =   &H00FF0000&
  200.          Height          =   180
  201.          Left            =   8625
  202.          TabIndex        =   3
  203.          Top             =   810
  204.          Width           =   90
  205.       End
  206.       Begin VB.Label tsLabel 
  207.          AutoSize        =   -1  'True
  208.          BackStyle       =   0  'Transparent
  209.          Caption         =   "会计期间:"
  210.          Height          =   180
  211.          Index           =   0
  212.          Left            =   720
  213.          TabIndex        =   2
  214.          Top             =   810
  215.          Width           =   810
  216.       End
  217.    End
  218.    Begin VB.Timer Timer1 
  219.       Interval        =   1
  220.       Left            =   3570
  221.       Top             =   570
  222.    End
  223.    Begin VSFlex6DAOCtl.vsFlexGrid CzxsGrid 
  224.       Height          =   4485
  225.       Left            =   0
  226.       TabIndex        =   0
  227.       Top             =   1740
  228.       Width           =   9240
  229.       _ExtentX        =   16298
  230.       _ExtentY        =   7911
  231.       _ConvInfo       =   1
  232.       Appearance      =   1
  233.       BorderStyle     =   1
  234.       Enabled         =   -1  'True
  235.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  236.          Name            =   "宋体"
  237.          Size            =   9
  238.          Charset         =   134
  239.          Weight          =   400
  240.          Underline       =   0   'False
  241.          Italic          =   0   'False
  242.          Strikethrough   =   0   'False
  243.       EndProperty
  244.       MousePointer    =   0
  245.       BackColor       =   16777215
  246.       ForeColor       =   -2147483640
  247.       BackColorFixed  =   -2147483648
  248.       ForeColorFixed  =   -2147483630
  249.       BackColorSel    =   -2147483635
  250.       ForeColorSel    =   -2147483634
  251.       BackColorBkg    =   8421504
  252.       BackColorAlternate=   16777215
  253.       GridColor       =   -2147483633
  254.       GridColorFixed  =   -2147483632
  255.       TreeColor       =   -2147483632
  256.       FloodColor      =   192
  257.       SheetBorder     =   -2147483642
  258.       FocusRect       =   1
  259.       HighLight       =   1
  260.       AllowSelection  =   -1  'True
  261.       AllowBigSelection=   -1  'True
  262.       AllowUserResizing=   0
  263.       SelectionMode   =   0
  264.       GridLines       =   1
  265.       GridLinesFixed  =   2
  266.       GridLineWidth   =   1
  267.       Rows            =   200
  268.       Cols            =   10
  269.       FixedRows       =   1
  270.       FixedCols       =   0
  271.       RowHeightMin    =   0
  272.       RowHeightMax    =   0
  273.       ColWidthMin     =   0
  274.       ColWidthMax     =   0
  275.       ExtendLastCol   =   0   'False
  276.       FormatString    =   ""
  277.       ScrollTrack     =   0   'False
  278.       ScrollBars      =   3
  279.       ScrollTips      =   0   'False
  280.       MergeCells      =   0
  281.       MergeCompare    =   0
  282.       AutoResize      =   -1  'True
  283.       AutoSizeMode    =   0
  284.       AutoSearch      =   0
  285.       MultiTotals     =   -1  'True
  286.       SubtotalPosition=   1
  287.       OutlineBar      =   0
  288.       OutlineCol      =   0
  289.       Ellipsis        =   0
  290.       ExplorerBar     =   0
  291.       PicturesOver    =   0   'False
  292.       FillStyle       =   0
  293.       RightToLeft     =   0   'False
  294.       PictureType     =   0
  295.       TabBehavior     =   0
  296.       OwnerDraw       =   0
  297.       Editable        =   0   'False
  298.       ShowComboButton =   -1  'True
  299.       WordWrap        =   0   'False
  300.       TextStyle       =   0
  301.       TextStyleFixed  =   0
  302.       OleDragMode     =   0
  303.       OleDropMode     =   0
  304.       DataMode        =   0
  305.       VirtualData     =   -1  'True
  306.    End
  307.    Begin MSComctlLib.Toolbar SzToolbar 
  308.       Align           =   1  'Align Top
  309.       Height          =   570
  310.       Left            =   0
  311.       TabIndex        =   9
  312.       Top             =   0
  313.       Width           =   9240
  314.       _ExtentX        =   16298
  315.       _ExtentY        =   1005
  316.       ButtonWidth     =   820
  317.       ButtonHeight    =   953
  318.       AllowCustomize  =   0   'False
  319.       Appearance      =   1
  320.       Style           =   1
  321.       ImageList       =   "ImageList1"
  322.       _Version        =   393216
  323.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  324.          NumButtons      =   9
  325.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  326.             Caption         =   "设置"
  327.             Key             =   "ymsz"
  328.             ImageKey        =   "sz"
  329.             BeginProperty ButtonMenus {66833FEC-8583-11D1-B16A-00C0F0283628} 
  330.                NumButtonMenus  =   1
  331.                BeginProperty ButtonMenu1 {66833FEE-8583-11D1-B16A-00C0F0283628} 
  332.                EndProperty
  333.             EndProperty
  334.          EndProperty
  335.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  336.             Caption         =   "打印"
  337.             Key             =   "dy"
  338.             ImageKey        =   "dy"
  339.          EndProperty
  340.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  341.             Caption         =   "预览"
  342.             Key             =   "yl"
  343.             ImageKey        =   "yl"
  344.          EndProperty
  345.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  346.             Style           =   3
  347.          EndProperty
  348.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  349.             Caption         =   "定义"
  350.             Key             =   "define"
  351.             ImageKey        =   "define"
  352.          EndProperty
  353.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  354.             Caption         =   "结转"
  355.             Key             =   "run"
  356.             ImageKey        =   "exec"
  357.          EndProperty
  358.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  359.             Style           =   3
  360.          EndProperty
  361.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  362.             Caption         =   "帮助"
  363.             Key             =   "bz"
  364.             ImageKey        =   "bz"
  365.          EndProperty
  366.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  367.             Caption         =   "退出"
  368.             Key             =   "fh"
  369.             ImageKey        =   "tc"
  370.          EndProperty
  371.       EndProperty
  372.       BorderStyle     =   1
  373.       Begin MSComctlLib.Toolbar GsToolbar 
  374.          Height          =   540
  375.          Left            =   6630
  376.          TabIndex        =   10
  377.          Top             =   0
  378.          Width           =   2595
  379.          _ExtentX        =   4577
  380.          _ExtentY        =   953
  381.          ButtonWidth     =   1455
  382.          ButtonHeight    =   953
  383.          AllowCustomize  =   0   'False
  384.          Appearance      =   1
  385.          Style           =   1
  386.          ImageList       =   "ImageList1"
  387.          _Version        =   393216
  388.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  389.             NumButtons      =   3
  390.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  391.                Caption         =   "保存格式"
  392.                Key             =   "bcgs"
  393.                ImageKey        =   "bcgs"
  394.             EndProperty
  395.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  396.                Caption         =   "默认列宽"
  397.                Key             =   "hfmrgs"
  398.                ImageKey        =   "mrlk"
  399.             EndProperty
  400.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  401.                Caption         =   "显示项目"
  402.                Key             =   "szxsxm"
  403.                ImageKey        =   "xsxm"
  404.             EndProperty
  405.          EndProperty
  406.       End
  407.    End
  408. End
  409. Attribute VB_Name = "JZ_FrmTranList"
  410. Attribute VB_GlobalNameSpace = False
  411. Attribute VB_Creatable = False
  412. Attribute VB_PredeclaredId = True
  413. Attribute VB_Exposed = False
  414. '*******************************************************
  415. '*    模 块 名 称 :自动转帐列表
  416. '*    功 能 描 述 :所有通过定义转帐关系能进行自动转帐的目录清单及执行转帐过程
  417. '*    程序员姓名  : 姜冬梅
  418. '*    最后修改人  : 魏永生
  419. '*    最早完成时间:2001/04/30
  420. '*    最近修改时间:2001/11/29
  421. '*    备        注:经过自己测试
  422. '*******************************************************
  424. '修改]
  425. Dim Rec_AutoTranMain As New ADODB.Recordset            '转帐过程主表中
  426. Dim Rec_AutoTranItem As New ADODB.Recordset            '转帐过程辅表
  428. Dim RecTemp As New ADODB.Recordset                     '临时数据表
  429. Dim SqlStr As String                                   '查询字符串
  430. Dim Jsqte As Long                                      '临时计数器
  431. '
  432. Dim Je As Double                                       '取金额
  433. Dim Jhj As Double                                      '借合计金额
  434. Dim Dhj As Double                                      '贷合计金额
  436. Dim Sl As Double                                       '取数量
  437. Dim Jhjsl As Double                                    '借合计数量
  438. Dim Dhjsl As Double                                    '贷合计数量
  441. Dim ItemSl As Double                                   '取数量
  442. Dim JhjItemSl As Double                                '借合计数量
  443. Dim DhjItemSl As Double                                '贷合计数量
  446. Dim OperationNum    As Integer                          '本次转帐操作批号
  447. Dim Jsq_Eff  As Integer                                 '本批有效转帐过程总数
  448. Dim TranJsq As Integer                                  '本批选择的转帐过程个数计数器
  449. Dim TranNum() As String                                 '转帐过程数组
  450. Dim TranVouchClass() As String                          '转帐凭证类别数组
  451. Dim Bln_DeleteFlag As Boolean                           '转帐后是否删除临时表
  453. Dim Int_Year As Integer                                 '会计年份
  454. Dim Int_Period As Integer                               '会计期间
  456. Dim jdzygs As Integer                       '控件焦点转移个数
  457. Dim Lrzt As Integer                         '录入状态标志(0-非录入状态 1-增加 2-修改)
  458. Dim ReportTitle As String                   '报表主标题
  459. Public TranClassCode As String              '转帐类型编码
  460.   
  461. '以下为固定使用变量(网格)
  462. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  463. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  464. Dim GridCode As String                   '显示网格网格代码
  465. Dim GridInf() As Variant                 '整个网格设置信息
  466. Dim Tsxx As String                       '系统提示信息
  467. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  468. Dim Sjhgd As Double                      '网格数据行高度
  469. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  470. Dim GridStr()  As String                 '网格列信息(字符型)
  471. Dim GridInt() As Integer                 '网格列信息(整型)
  472. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  474. '以下为固定使用变量(文本框)
  475. Dim Textvar() As Variant                 '存储变体型文本框信息
  476. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  477. Dim Textint() As Integer                 '存储整型文本框信息
  478. Dim Textstr() As String                  '存储字符型文本框信息
  479. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  480. Dim TextGroupCode As String              '文本框录入分组编码
  481. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  482. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁,=True时光标离开不需要马上进行判断
  483. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  484.     
  485.     jdzygs = 6
  486.     Select Case KeyAscii
  487.     Case vbKeyReturn
  488.         If Kjjdzy(jdzygs) Then
  489.             KeyAscii = 0
  490.         End If
  491.     Case 39           '屏蔽"'"
  492.         KeyAscii = 0
  493.     End Select
  494.     
  495. End Sub
  497. Private Sub Form_Load()
  498.     
  499.     '报表主标题及报表编码
  500.     ReportTitle = "结转生产成本"
  501.     XtReportCode = "CB_CostCarryForward"
  502.     Load Dyymctbl
  503.     
  504.     '调入网格
  505.     GridCode = "CB_CostCarryForward"          '网格属性编码
  506.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  507.     Qslz = GridInf(1)
  508.     Sjhgd = GridInf(2)
  509.     Szzls = CzxsGrid.Cols - 1
  510.     
  511.     '填 充 网 格
  512.     Call Cxnrtcwg
  513.     
  514.     '[自定义
  515.     '填充会计期间列表框(年度默认为用户选择年度)
  516.     Call Sub_FillPeriod(Combo_KJQJ, Xtyear, Xtmm)
  517.     '自定义]
  518.     
  519. End Sub
  521. Private Sub Cxnrtcwg()                               '查询内容填充网格
  522.     
  523.     SqlStr = "Select A.Objectcode,ObjectName,UnitName,Quantity,ThmonCost,TranEngSign From Cb_ObjectComplete A " _
  524.                 & "Left Outer Join (Select ObjectCode,ObjectName,UnitName From Cb_CostObject A " _
  525.                 & "Left Outer Join Gy_UnitSet B On A.MeasureUnitCode=B.UnitCode) B On A.ObjectCode=B.ObjectCode"
  526.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  527.     With RecTemp
  528.         CzxsGrid.Clear 1
  529.         CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
  530.         If .EOF And .BOF Then
  531.             Exit Sub
  532.         End If
  533.         Jsqte = CzxsGrid.FixedRows
  534.         Do While Not .EOF
  535.             If Jsqte >= CzxsGrid.Rows Then
  536.                 CzxsGrid.AddItem ""
  537.             End If
  538.             Call Jltcwg(RecTemp, Jsqte)
  539.             CzxsGrid.RowHeight(Jsqte) = Sjhgd
  540.             .MoveNext
  541.             Jsqte = Jsqte + 1
  542.         Loop
  543.     End With
  544.     
  545. End Sub
  547. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)                                     '记录内容填充网格
  548.     
  549.     With Jlbrec
  550.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Objectcode"))
  551.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("ObjectName"))
  552.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("UnitName") & "")
  553.         CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Quantity") & "")
  554.         CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("ThmonCost") & "")
  555.         CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Auditing") & "")
  556.     End With
  557.     
  558. End Sub
  560. Private Sub Wbkcsh()                          '录入文本框初始化
  561.     
  562.     Dim Jsqte As Integer
  563.     '最大录入文本框索引值
  564.     Max_Text_Index = Textvar(1)
  565.     ReDim TextValiJudgeLock(Max_Text_Index)
  566.     For Jsqte = 0 To Max_Text_Index
  567.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then   '如果文本框索引值不为0，即不是“编码”文本框
  568.             If Textboolean(Jsqte, 1) Then   '如果该文本框处需要提供帮助
  569.                 If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then    '
  570.                     Load Ydcommand1(Jsqte)
  571.                 End If
  572.                 Ydcommand1(Jsqte).Visible = True
  573.                 Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
  574.             End If
  575.             TextChangeLock = True
  576.             LrText(Jsqte).Text = ""
  577.             LrText(Jsqte).Tag = ""
  578.             If Textint(Jsqte, 5) <> 0 Then   '如果字段录入长度不等于0
  579.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)  '该文本框的最大录入长度赋值给文本框的MaxLength
  580.             End If
  581.             TextChangeLock = False
  582.         End If
  583.         TextValiJudgeLock(Jsqte) = True
  584.     Next Jsqte
  585.     
  586. End Sub
  588. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  589.     
  590.     TranClassCode = ""
  591.     Set Cxnrrec = Nothing
  592.     Unload Dyymctbl
  593.     Set Rec_AutoTranMain = Nothing
  594.     Set Rec_AutoTranItem = Nothing
  595.     Set RecTemp = Nothing
  596.     
  597. End Sub
  599. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  600.     
  601.     Dim Jsqte As Integer
  602.     For Jsqte = 0 To Max_Text_Index
  603.         If Textint(Jsqte, 8) = 1 Then     '如果字段不能为空
  604.             If Len(Trim(LrText(Jsqte).Text)) = 0 Then
  605.                 Tsxx = Textstr(Jsqte, 7) & "不能为空!"
  606.                 Call Xtxxts(Tsxx, 0, 1)
  607.                 LrText(Jsqte).SetFocus
  608.                 Bclrsj = False
  609.                 Exit Function
  610.             End If
  611.         Else
  612.             If Textint(Jsqte, 8) = 2 Then   '如果字段不能为零
  613.                 If Val(Trim(LrText(Jsqte).Text)) = 0 Then
  614.                     Tsxx = Textstr(Jsqte, 7) & "不能为零!"
  615.                     Call Xtxxts(Tsxx, 0, 1)
  616.                     LrText(Jsqte).SetFocus
  617.                     Bclrsj = False
  618.                     Exit Function
  619.                 End If
  620.             End If
  621.         End If
  622.     Next Jsqte
  623.     
  624.     If ImgCmbClass.Text = "" Then
  625.         Tsxx = tsLabel(2).Caption & "不能为空!"
  626.         Call Xtxxts(Tsxx, 0, 1)
  627.         ImgCmbClass.SetFocus
  628.         Bclrsj = False
  629.         Exit Function
  630.     Else
  631.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * from Cwzz_VouchClass Where VouchClassCode='" & Trim(GetComboKey(ImgCmbClass, 0)) & "'")
  632.     End If
  633.     
  634.     '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  635.     For Jsqte = 0 To Max_Text_Index
  636.         If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then   '需要进行有效性判断的字段存盘之前再进行判断。
  637.             If Not TextYxxpd(Jsqte) Then
  638.                 Exit Function
  639.             End If
  640.         End If
  641.     Next Jsqte
  642.     
  643.     On Error GoTo Swcwcl
  644.     If Lrzt = 1 Then  '增 加一个新编码时
  645.         With Rec_AutoTranMain
  646.             If .State = 1 Then .Close
  647.             .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranCode= '" + Trim(LrText(0).Text) + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  648.             If Not .EOF Then
  649.                 Tsxx = "转帐编码重复!"
  650.                 Call Xtxxts(Tsxx, 0, 1)
  651.                 LrText(0).SetFocus
  652.                 Bclrsj = False
  653.                 Exit Function
  654.             End If
  655.             If .State = 1 Then .Close
  656.             .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranName= '" + Trim(LrText(1).Text) + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  657.             If Not .EOF Then
  658.                 Tsxx = "转帐名称重复!"
  659.                 Call Xtxxts(Tsxx, 0, 1)
  660.                 LrText(1).SetFocus
  661.                 Bclrsj = False
  662.                 Exit Function
  663.             End If
  664.             .AddNew
  665.             .Fields("TranClass") = TranClassCode
  666.             .Fields("TranCode") = Trim(LrText(0).Text)
  667.             .Fields("TranName") = Trim(LrText(1).Text)
  668.             .Fields("VouchClassCode") = Trim(GetComboKey(ImgCmbClass, 0))
  669.             .Update
  670.         End With
  671.         SqlStr = "SELECT cwzz_VouchClass.VouchClassCode,cwzz_VouchClass.VouchClassName, Cwzz_AutoTranMain.TranName, " & _
  672.         "Cwzz_AutoTranMain.TranCode, Cwzz_AutoTranMain.VouchClassCode," & _
  673.         "Cwzz_AutoTranMain.EndTranDate , Cwzz_AutoTranMain.Bill FROM Cwzz_AutoTranMain LEFT OUTER JOIN " & _
  674.         "Cwzz_VouchClass ON " & _
  675.         "Cwzz_AutoTranMain.VouchClassCode = Cwzz_VouchClass.VouchClassCode WHERE trancode = '" & Trim(LrText(0)) & "' and TranClass='" & TranClassCode & "'" & _
  676.         "ORDER BY Cwzz_AutoTranMain.TranCode"
  677.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  678.         With CzxsGrid
  679.             .AddItem ""
  680.             .RowHeight(.Rows - 1) = Sjhgd
  681.             .Select .Rows - 1, Qslz
  682.             Call Jltcwg(RecTemp, .Rows - 1)
  683.         End With
  684.         
  685.         Tsxx = "保存成功!"
  686.         Call Xtxxts(Tsxx, 0, 4)
  687.         Call Cshlrxx(1)
  688.         LrText(0).SetFocus
  689.     Else  '修改转帐名称或转帐类型时 修改编辑状态
  690.         With Rec_AutoTranMain
  691.             If .State = 1 Then .Close
  692.             .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranName= '" + Trim(LrText(1).Text) + "' and TranCode<>'" & Trim(LrText(0).Text) & "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  693.             If Not .EOF Then
  694.                 Tsxx = "转帐名称重复!"
  695.                 Call Xtxxts(Tsxx, 0, 1)
  696.                 LrText(1).SetFocus
  697.                 Bclrsj = False
  698.                 Exit Function
  699.             End If
  700.             If .State = 1 Then .Close
  701.             .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranCode= '" + LrText(0).Text + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  702.             If Not .EOF Then
  703.                 .Fields("TranName") = Trim(LrText(1).Text)
  704.                 .Fields("VouchClassCode") = Trim(GetComboKey(ImgCmbClass, 0))
  705.             End If
  706.             .Update
  707.             .Close
  708.         End With
  709.         SqlStr = "SELECT Cwzz_VouchClass.VouchClassName, Cwzz_AutoTranMain.TranName," & _
  710.         "Cwzz_AutoTranMain.TranCode,Cwzz_AutoTranMain.VouchClassCode, Cwzz_AutoTranMain.EndTranDate," & _
  711.         "Cwzz_AutoTranMain.Bill    FROM Cwzz_AutoTranMain LEFT OUTER JOIN " & _
  712.         "Cwzz_VouchClass ON  Cwzz_AutoTranMain.VouchClassCode = Cwzz_VouchClass.VouchClassCode  WHERE trancode = '" & Trim(LrText(0)) & "' and TranClass='" & TranClassCode & "'"
  713.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  714.         If Not RecTemp.EOF Then
  715.             Call Jltcwg(RecTemp, CzxsGrid.Row)
  716.         End If
  717.     End If
  718.     Bclrsj = True
  719.     Exit Function
  720.     
  721. Swcwcl:
  722.     Tsxx = "存盘过程中出现错误,请退出后重新进入!"
  723.     Call Xtxxts(Tsxx, 0, 1)
  724.     Exit Function
  725.     
  726. End Function
  728. Private Sub Cshlrxx(lrztxx As Integer)              '初始化录入字段信息
  729.     
  730.     TextChangeLock = True       '关闭Chang事件
  731.     If lrztxx = 1 Then              '新增状态
  732.         For Jsqte = 0 To Max_Text_Index
  733.             If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then  '文本框索引值
  734.                 TextChangeLock = True
  735.                 LrText(Jsqte).Text = ""
  736.                 LrText(Jsqte).Tag = ""
  737.                 TextChangeLock = False
  738.             End If
  739.             TextValiJudgeLock(Jsqte) = True
  740.         Next Jsqte
  741.         ImgCmbClass.Text = ""
  742.     Else                            '其他状态，修改、非编辑
  743.         With CzxsGrid
  744.             LrText(0).Text = Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)))
  745.             LrText(1).Text = Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls)))
  746.             ImgCmbClass.Text = Trim(.TextMatrix(.Row, Sydz("003", GridStr(), Szzls)))
  747.         End With
  748.     End If
  749.     TextChangeLock = False
  750.     
  751. End Sub
  753. Private Sub Scdqjl()                 '删 除 当 前 记 录
  754.     
  755.     Dim yhAnswer As Integer
  756.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  757.         Exit Sub
  758.     End If
  759.     Tsxx = "请确认是否删除当前记录?"
  760.     yhAnswer = Xtxxts(Tsxx, 2, 2)
  761.     If yhAnswer = 2 Then
  762.         Exit Sub
  763.     End If
  764.     On Error GoTo Cwcl
  765.     
  766.     Cw_DataEnvi.DataConnect.BeginTrans
  767.     Cw_DataEnvi.DataConnect.Execute "delete Cwzz_AutoTranItem where TranCode= '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "' and TranClass='" & TranClassCode & "'"
  768.     Cw_DataEnvi.DataConnect.Execute "delete Cwzz_AutoTranMain where TranCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "' and TranClass='" & TranClassCode & "'"
  769.     Cw_DataEnvi.DataConnect.CommitTrans
  770.     
  771.     CzxsGrid.RemoveItem CzxsGrid.Row
  772.     Exit Sub
  773.     
  774. Cwcl:
  775.     If Err.Number = -2147217900 Then
  776.         Tsxx = "该编码已经被使用,不能删除!"
  777.         Call Xtxxts(Tsxx, 0, 1)
  778.         Exit Sub
  779.     Else
  780.         Tsxx = "出现未知情况,该编码不能被删除!"
  781.         Call Xtxxts(Tsxx, 0, 1)
  782.         Exit Sub
  783.     End If
  784.     
  785. End Sub
  787. '******************以下为基本处理程序(固定不变)************************'
  788. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  789.     If Shift = 2 Then
  790.         Select Case UCase(Chr(KeyCode))
  791.         Case "P"                   'Ctrl+P 打印
  792.             Call bbyl(False)
  793.         Case "I"                   'Ctrl+I 增加
  794.             Call Toolbjzt
  795.             Lrzt = 1
  796.             Call Cshlrxx(Lrzt)
  797.             LrText(0).SetFocus
  798.             LrText(0).Locked = False
  799.         Case "D"                   'Ctrl+D 删除
  800.             Call Scdqjl
  801.         End Select
  802.     End If
  803. End Sub
  805. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  806.     Select Case Button.Key
  807.     Case "ymsz"                                          '页面设置
  808.         Dyymctbl.Show 1
  809.     Case "yl"                                            '预 览
  810.         Call bbyl(True)
  811.     Case "dy"                                            '打 印
  812.         Call bbyl(False)
  813.     Case "zj"                                            '增 加
  814.         Call Toolbjzt
  815.         Lrzt = 1
  816.         Call Cshlrxx(Lrzt)
  817.         LrText(0).SetFocus
  818.         LrText(0).Locked = False
  819.     Case "xg"                                            '修 改
  820.         Call Xgdqjl
  821.     Case "sc"                                            '删 除
  822.         Call Scdqjl
  823.     Case "fq"                                            '取 消
  824.         Call Toolfbjzt
  825.     Case "sx"                                            '刷 新
  826.         Call Cxnrtcwg
  827.     Case "bz"                                            '帮 助
  828.         Call F1bz
  829.     Case "fh"                                            '退 出
  830.         Unload Me
  831.         '[自定义
  832.     Case "run"
  833.         '[>>计算会计期间
  834.         Int_Year = Val(Mid(Combo_KJQJ.Text, 1, 4))
  835.         Int_Period = Val(Mid(Combo_KJQJ.Text, 6, 2))
  836.         '<<]
  837.         Select Case TranClassCode
  838.         Case "01"                           '执行自定义转帐凭证
  839.             Call Run1
  840.         Case "04"                           '执行期间损益
  841.             Call Run4
  842.         Case "05"                           '模式转帐凭证
  843.             Call Run5
  844.         Case "03"                           '汇兑损益凭证
  845.             Call Run3
  846.         End Select
  847.     Case "define"                                '定义转帐凭证
  848.         Call Define
  849.         '自定义]
  850.     End Select
  851. End Sub
  853. Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
  854.     With CzxsGrid
  855.         If .Row < .FixedRows Then
  856.             Exit Sub
  857.         End If
  858.         If GridStr(.Col, 1) <> "006" Then
  859.             Call Xgdqjl
  860.         Else
  861.             If .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = "√" Then
  862.                 .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = ""
  863.             Else
  864.                 .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = "√"
  865.             End If
  866.         End If
  867.     End With
  868. End Sub
  870. Private Sub Xgdqjl()                                       '修改当前编码记录
  871.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  872.         Exit Sub
  873.     End If
  874.     Call Toolbjzt
  875.     Lrzt = 2
  876.     Call Cshlrxx(Lrzt)
  877.     LrText(1).SetFocus
  878.     LrText(0).Locked = True
  879. End Sub
  881. Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
  882.     StTab.TabEnabled(1) = True
  883.     StTab.Tab = 1
  884.     Frame1.Enabled = True
  885.     StTab.TabEnabled(0) = False
  886.     CzxsGrid.Enabled = False
  887.     With SzToolbar
  888.         .Buttons("ymsz").Enabled = False
  889.         .Buttons("dy").Enabled = False
  890.         .Buttons("yl").Enabled = False
  891.         .Buttons("zj").Enabled = False
  892.         .Buttons("xg").Enabled = False
  893.         .Buttons("sc").Enabled = False
  894.         '[自定义
  895.         .Buttons("define").Enabled = False
  896.         .Buttons("run").Enabled = False
  897.         '自定义]
  898.     End With
  899.     '[自定义
  900.     With GsToolbar
  901.         .Buttons("bcgs").Enabled = False
  902.         .Buttons("hfmrgs").Enabled = False
  903.         .Buttons("szxsxm").Enabled = False
  904.     End With
  905.     '自定义]
  906. End Sub
  908. Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
  909.     StTab.TabEnabled(0) = True
  910.     StTab.Tab = 0
  911.     CzxsGrid.Enabled = True
  912.     Frame1.Enabled = False
  913.     StTab.TabEnabled(1) = False
  914.     Lrzt = 0
  915.     With SzToolbar
  916.         .Buttons("ymsz").Enabled = True
  917.         .Buttons("dy").Enabled = True
  918.         .Buttons("yl").Enabled = True
  919.         .Buttons("zj").Enabled = True
  920.         .Buttons("xg").Enabled = True
  921.         .Buttons("sc").Enabled = True
  922.         '[自定义
  923.         .Buttons("define").Enabled = True
  924.         .Buttons("run").Enabled = True
  925.         '自定义]
  926.     End With
  927.     '[自定义
  928.     With GsToolbar
  929.         .Buttons("bcgs").Enabled = True
  930.         .Buttons("hfmrgs").Enabled = True
  931.         .Buttons("szxsxm").Enabled = True
  932.     End With
  933.     '自定义]
  934. End Sub
  936. Private Sub BcCommand_Click()                                           '保 存
  937.     If Not Bclrsj Then
  938.         Exit Sub
  939.     End If
  940.     If Lrzt = 2 Then   '修改编辑状态
  941.         Call Toolfbjzt
  942.     End If
  943. End Sub
  945. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)       '取消
  946.     '避免执行Click程序
  947.     Bln_Cancel = True
  948.     Call Cancel
  949. End Sub
  951. Private Sub QxCommand_Click()                                                                         '取消
  952.     If Bln_Cancel Then
  953.         Bln_Cancel = False
  954.         Exit Sub
  955.     End If
  956.     Call Cancel
  957. End Sub
  959. Private Sub Cancel()                                                                                  '取消
  960.     '文本框加锁
  961.     For Jsqte = 0 To Max_Text_Index
  962.         TextValiJudgeLock(Jsqte) = True  '光标离开不必进行有效性判断
  963.     Next Jsqte
  964.     Call Toolfbjzt
  965. End Sub
  967. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  968.     Select Case Button.Key
  969.     Case "bcgs"                              '保存表格格式
  970.         Call Bcwggs(CzxsGrid, GridCode, GridStr())
  971.     Case "hfmrgs"                            '恢复默认格式
  972.         Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  973.     Case "szxsxm"                            '设置显示项目
  974.         Call Szxsxm(CzxsGrid, GridCode)
  975.     End Select
  976. End Sub
  978. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  979.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  980.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  981.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  982.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  983.     ReDim Bbxbt(1 To Bbxbtgs)
  984.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  985.     If Bbbwhgs <> 0 Then
  986.         ReDim Bbbwh(1 To Bbbwhgs)
  987.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  988.     End If
  989.     Bbzbt = ReportTitle
  990.     Bbxbt(1) = " "
  991.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  992.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  993.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  994.     If Not bbylte Then
  995.         Unload DY_Tybbyldy
  996.     End If
  997. End Sub
  999. '************以下为文本框录入处理程序(固定不变部分)*************'
  1001. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1002.     
  1003.     '以下为依据实际情况自定义部分[
  1004.     
  1005.     '在此填写文本框录入事后处理程序
  1006.     SendKeys "vbtab"
  1007.     ']以上为依据实际情况自定义部分
  1008. End Sub
  1010. Private Sub LrText_Change(Index As Integer)
  1011.     
  1012.     '屏蔽程序改变控制
  1013.     If TextChangeLock Then
  1014.         Exit Sub
  1015.     End If
  1016.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1017.     '限制字段录入长度
  1018.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1019.     Select Case Textint(Index, 1)  '文本框索引值
  1020.     Case 8           '金额型
  1021.         Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1022.     Case 9           '数量型
  1023.         Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1024.     Case 10          '单价型
  1025.         Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1026.     Case Else        '其他小数类型控制
  1027.         If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then  '字段小数位个数、整数位个数。
  1028.             Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1029.         End If
  1030.     End Select
  1031.     TextChangeLock = False '解锁
  1032. End Sub
  1034. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1035.     Call TextShow(Index)
  1036.     CurTextIndex = Index
  1037.     LrText(Index).SelStart = Len(LrText(Index))
  1038. End Sub
  1040. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1041.     Select Case KeyCode
  1042.     Case vbKeyF2
  1043.         Call Text_Help(Index)
  1044.     End Select
  1045. End Sub
  1047. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1048.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1049. End Sub
  1051. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  1052.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  1053.         Call TextYxxpd(Index)
  1054.     End If
  1055. End Sub
  1057. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)     '按钮提供帮助
  1058.     Call Text_Help(Index)
  1059. End Sub
  1061. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1062.     If Not Textboolean(Index, 1) Then
  1063.         Exit Sub
  1064.     End If
  1065.     TextValiJudgeLock(Index) = True   '按帮助按纽时，不进行有效性判断
  1066.     
  1067.     '先进行有效性判断
  1068.     If Not TextYxxpd(CurTextIndex) Then
  1069.         Exit Sub
  1070.     End If
  1071.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))  '帮助类型，帮助编码（HelpCode），文本框录入内容
  1072.     If Len(Xtfhcs) <> 0 Then
  1073.         If Textint(Index, 3) = 1 Then   '如果返回显示名称
  1074.             LrText(Index).Text = Xtfhcsfz
  1075.             LrText(Index).Tag = Xtfhcs
  1076.         Else                            '如果返回显示编码
  1077.             LrText(Index).Text = Xtfhcs
  1078.             LrText(Index).Tag = Xtfhcsfz
  1079.         End If
  1080.     End If
  1081.     TextValiJudgeLock(Index) = False
  1082.     LrText(Index).SetFocus
  1083. End Sub
  1085. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1086.     
  1087.     '填写文本框得到焦点,进行相应信息处理程序
  1088.     '可以填写帮助按纽显示并调整位置。
  1089. End Sub
  1091. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断，数据的正确性
  1092.     '可以补充自定义限制
  1093.     If TextValiJudgeLock(Index) Then    '=True文本框内容不需进行有效性判断时，退出
  1094.         TextYxxpd = True
  1095.         Exit Function
  1096.     End If
  1097.     If Trim(LrText(Index)) = "" Then
  1098.         LrText(Index).Tag = ""
  1099.         Call Wbklrwbcl(Index)
  1100.         TextValiJudgeLock(Index) = True  '文本框内容不需进行有效性判断时，退出
  1101.         TextYxxpd = True
  1102.         Exit Function
  1103.     End If
  1104.     Select Case Textint(Index, 4)
  1105.     Case 1      '编码型
  1106.         SqlStr = Trim(Textstr(Index, 5)) '有效性判断依据有内容时
  1107.         SqlStr = Replace(SqlStr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1108.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1109.         If RecTemp.EOF Then
  1110.             Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1111.             LrText(Index).SetFocus
  1112.             Exit Function
  1113.         Else
  1114.             Select Case Textint(Index, 3) '显示编码还是显示名称
  1115.             Case 0 '显示编码
  1116.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1117.                     LrText(Index).Text = Trim(RecTemp.Fields(Trim(Textstr(Index, 2))))
  1118.                 End If
  1119.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1120.                     LrText(Index).Tag = Trim(RecTemp.Fields(Trim(Textstr(Index, 3))))
  1121.                 End If
  1122.             Case 1 '显示名称
  1123.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1124.                     LrText(Index).Text = Trim(RecTemp.Fields(Trim(Textstr(Index, 3))))
  1125.                 End If
  1126.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1127.                     LrText(Index).Tag = Trim(RecTemp.Fields(Trim(Textstr(Index, 2))))
  1128.                 End If
  1129.             End Select
  1130.         End If
  1131.     Case 2      '日期型
  1132.         If IsDate(LrText(Index).Text) Then
  1133.             LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1134.         Else
  1135.             Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1136.             Call Xtxxts(Tsxx, 0, 1)
  1137.             LrText(Index).SetFocus
  1138.             Exit Function
  1139.         End If
  1140.     Case 3      '其他类型
  1141.     End Select
  1142.     TextValiJudgeLock(Index) = True
  1143.     TextYxxpd = True
  1144. End Function
  1146. Public Sub Define()             '定义转帐关系
  1147.     
  1148.     Dim gnsybm As String      '功能索引编码
  1149.     Dim gnsymc As String      '功能索引名称
  1150.     If CzxsGrid.Rows = CzxsGrid.FixedRows Then
  1151.         Tsxx = "请首先新增转帐过程!"
  1152.         Call Xtxxts(Tsxx, 0, 4)
  1153.         Exit Sub
  1154.     End If
  1155.     If Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) = "" Then
  1156.         Tsxx = "请选择转帐过程!"
  1157.         Call Xtxxts(Tsxx, 0, 4)
  1158.         Exit Sub
  1159.     Else
  1160.         '为转帐定义窗体传递该转帐过程参数
  1161.         CzxsGrid.Tag = CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))
  1162.         SqlStr = "Select * From Xt_xtgnb where gnmc='" & Xt_Control.tvTreeView.SelectedItem.Text & "'"
  1163.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1164.         gnsybm = Trim(RecTemp.Fields("gnsy") & "")
  1165.         gnsymc = Trim(RecTemp.Fields("gnmc") & "")
  1166.         Select Case gnsybm
  1167.         Case "Cwzz_UserDefineTran"                                 '"自定义转帐凭证"
  1168.             AutoTran_DefiMy.Show 1
  1169.         Case "Cwzz_ProfitTran"                                     '"期间损益结转"
  1170.             AutoTran_DefiSy.Show 1
  1171.         Case "Cwzz_ModelTran"                                      '"模式结转凭证"
  1172.             AutoTran_DefiCus.Show 1
  1173.         Case "Cwzz_ExchangeTran"                                   '"汇兑损益凭证"
  1174.             AutoTran_DefiExchange.Show 1
  1175.         End Select
  1176.     End If
  1177.     
  1178. End Sub
  1180. Private Sub Run1()                                          '执行自定义转帐程序
  1181.     
  1182.     Dim Tj_Main As String                                   '总帐取数公式
  1183.     Dim Tj_List As String                                   '明细帐取数公式
  1184.     Dim Tj_Ass As String                                    '辅助帐取数公式
  1185.     
  1186.     Dim jsq As Integer                                      '临时计数器
  1187.     Dim i As Integer
  1188.     Dim Str_Formula As String                               '公式串
  1189.     Dim DestTranOri As String                               '对方汇总数的借贷方向
  1190.     Dim lng_OperationNum As Long
  1191.     Bln_DeleteFlag = True
  1192.     
  1193.     If Tran_Pd = False Then
  1194.         Exit Sub
  1195.     End If
  1196.     
  1197.     On Error GoTo Err1
  1198.     Cw_DataEnvi.DataConnect.BeginTrans
  1199.     
  1200.     TranCount = TranJsq          '记录生成凭证的个数
  1201.     VoidStr = ""         '记录没有数值的空凭证序号
  1202.     
  1203.     '对转帐列表网格内选中的TranJsq个转帐过程依次生成凭证，写到临时凭证数据表中
  1204.     For jsq = 1 To TranJsq
  1205.         
  1206.         '写临时凭证主表
  1207.         lng_OperationNum = CreatBillID("0102")
  1208.         Call Save_TempPz_Main(TranVouchClass(jsq), TranNum(jsq), OperationNum, lng_OperationNum)
  1209.         
  1210.         '对方汇总数的借贷方向
  1211.         SqlStr = "Select ccode,TranOri,FormulaString from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString like '%对方汇总数%' Order by AutoTranId"
  1212.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1213.         If Rec_AutoTranItem.EOF = False Then
  1214.             DestTranOri = Rec_AutoTranItem.Fields("tranori")
  1215.         End If
  1216.         
  1217.         Jhj = 0
  1218.         Dhj = 0   '对方汇总金额
  1219.         Jhjsl = 0
  1220.         Dhjsl = 0
  1221.         JhjItemSl = 0
  1222.         DhjItemSl = 0
  1223.         i = 0
  1224.         hjje = 0      '合计金额
  1225.         '按转帐定义关系，取每笔转帐数据，写入临时数据辅表中
  1226.         SqlStr = "select * from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString not like '%对方汇总数%' ORDER BY AutoTranId"
  1227.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1228.         Do While Rec_AutoTranItem.EOF = False
  1229.             
  1230.             Str_Formula = Trim(Rec_AutoTranItem.Fields("FormulaString"))
  1231.             Str_Formula = Fn_Replace(Str_Formula, Chk_Vouch.Value)
  1232.             
  1233.             SqlStr = "select " & Str_Formula & " as ReturnValue"
  1234.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1235.             If RecTemp.EOF = False Then
  1236.                 Je = IIf(IsNull(RecTemp.Fields("ReturnValue")), 0, RecTemp.Fields("ReturnValue"))
  1237.                 If Rec_AutoTranItem.Fields("tranori") <> DestTranOri Then
  1238.                     Dhj = Dhj + Je * IIf(Rec_AutoTranItem.Fields("tranori") = DestTranOri, -1, 1)
  1239.                 End If
  1240.                 
  1241.                 '写临时凭证辅表
  1242.                 If Je <> 0 Then
  1243.                     Call Save_TempPz_Ass(lng_OperationNum, i, Trim(Rec_AutoTranItem.Fields("Digest")), Trim(Rec_AutoTranItem.Fields("Ccode")), Trim(Rec_AutoTranItem.Fields("DeptCode") & ""), Trim(Rec_AutoTranItem.Fields("PersonCode") & ""), Trim(Rec_AutoTranItem.Fields("CusCode") & ""), Trim(Rec_AutoTranItem.Fields("Suppliercode") & ""), Trim(Rec_AutoTranItem.Fields("ItemCode") & ""), Trim(Rec_AutoTranItem.Fields("TranOri")))
  1244.                 End If
  1245.             End If
  1246.             Rec_AutoTranItem.MoveNext
  1247.             i = i + 1
  1248.             hjje = hjje + Je
  1249.         Loop
  1250.         
  1251.         '对方汇总
  1252.         SqlStr = "Select ccode,TranOri,FormulaString from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString like '%对方汇总数%' Order by AutoTranId"
  1253.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1254.         If Rec_AutoTranItem.EOF = False Then
  1255.             DestTranOri = Rec_AutoTranItem.Fields("tranori")
  1256.         End If
  1257.         
  1258.         '找到数据来源为对方汇总数的转帐关系
  1259.         SqlStr = "select * from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaString like '%对方汇总数%' ORDER BY AutoTranId"
  1260.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1261.         Do While Rec_AutoTranItem.EOF = False
  1262.             
  1263.             Str_Formula = Trim(Rec_AutoTranItem.Fields("FormulaString"))
  1264.             Str_Formula = Replace(Str_Formula, "对方汇总数", Str(Dhj))
  1265.             
  1266.             SqlStr = "select " & Str_Formula & " as ReturnValue"
  1267.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1268.             If RecTemp.EOF = False Then
  1269.                 Je = RecTemp.Fields("ReturnValue")
  1270.             End If
  1271.             Call Save_TempPz_Ass(lng_OperationNum, i, Trim(Rec_AutoTranItem.Fields("Digest")), Trim(Rec_AutoTranItem.Fields("Ccode")), Trim(Rec_AutoTranItem.Fields("DeptCode") & ""), Trim(Rec_AutoTranItem.Fields("PersonCode") & ""), Trim(Rec_AutoTranItem.Fields("CusCode") & ""), Trim(Rec_AutoTranItem.Fields("Suppliercode") & ""), Trim(Rec_AutoTranItem.Fields("ItemCode") & ""), Trim(Rec_AutoTranItem.Fields("TranOri")))
  1272.             Rec_AutoTranItem.MoveNext
  1273.             i = i + 1
  1274.         Loop
  1275.         
  1276.         If hjje = 0 Then              '合计金额
  1277.             '删除空凭证主从表
  1278.             SqlStr = "Delete From Cwzz_AccVouchSubTemp Where VouchId=" & lng_OperationNum
  1279.             Cw_DataEnvi.DataConnect.Execute SqlStr
  1280.             SqlStr = "Delete From Cwzz_AccVouchMainTemp Where VouchId=" & lng_OperationNum
  1281.             Cw_DataEnvi.DataConnect.Execute SqlStr
  1282.             VoidStr = VoidStr + Str(jsq) + " "
  1283.             TranCount = TranCount - 1
  1284.         End If
  1285.         
  1286.     Next jsq
  1287.     
  1288.     Cw_DataEnvi.DataConnect.CommitTrans
  1289.     
  1290.     '没有有效凭证生成，即金额、数量均为0
  1291.     If Len(VoidStr) <> 0 Then
  1292.         Tsxx = "第" & VoidStr & "张凭证没有发生额，不需要结转!"
  1293.         Call Xtxxts(Tsxx, 0, 4)
  1294.     End If
  1295.     
  1296.     If TranCount > 0 Then       '记录生成凭证的个数
  1297.         '记录此次转帐的批号,做为凭证窗体调用的参数
  1298.         AutoTran_PzFrm.Lab_OperNum.Caption = OperationNum
  1299.         
  1300.         '调入凭证制作窗体
  1301.         AutoTran_PzFrm.Show 1
  1302.         
  1303.         
  1304.         '为在转帐过程列表的网格中重新显示制单日期和操作员，防止虽转完，但无痕迹
  1305.         Call Write_Date
  1306.         Call Clean
  1307.     End If
  1308.     Call Cxnrtcwg
  1309.     Exit Sub
  1310. Err1:
  1311.     Cw_DataEnvi.DataConnect.RollbackTrans
  1312.     'Tsxx = "转帐过程中出现未知错误,程序自动恢复保存前状态!"
  1313.     Tsxx = Err.Description
  1314.     Call Xtxxts(Tsxx, 0, 1)
  1315.     Exit Sub
  1316.     
  1317. End Sub
  1319. Private Sub Run3()                                          '执行汇兑损益程序
  1320.     
  1321.     Dim Tj_Main As String                                   '总帐取数公式
  1322.     Dim Tj_List As String                                   '明细帐取数公式
  1323.     Dim Tj_Ass As String                                    '辅助帐取数公式
  1324.     
  1325.     Dim jsq As Integer                                      '临时计数器
  1326.     Dim i As Integer
  1327.     Dim Str_Formula As String                               '公式串
  1328.     Dim DestTranOri As String                               '对方汇总数的借贷方向
  1329.     Dim Str_ForeignCode As String                           '外币编码
  1330.     Dim Dec_AdjustRate As Double                            '汇率
  1331.     Dim lng_OperationNum As Long
  1332.     Bln_DeleteFlag = True
  1333.     
  1334.     If Tran_Pd = False Then
  1335.         Exit Sub
  1336.     End If
  1337.     
  1338.     On Error GoTo Err1
  1339.     Cw_DataEnvi.DataConnect.BeginTrans
  1340.     
  1341.     TranCount = TranJsq          '记录生成凭证的个数
  1342.     VoidStr = ""         '记录没有数值的空凭证序号
  1343.     
  1344.     '对转帐列表网格内选中的TranJsq个转帐过程依次生成凭证，写到临时凭证数据表中
  1345.     For jsq = 1 To TranJsq
  1346.         
  1347.         '写临时凭证主表
  1348.         
  1349.         lng_OperationNum = CreatBillID("0102")
  1350.         Call Save_TempPz_Main(TranVouchClass(jsq), TranNum(jsq), OperationNum, lng_OperationNum)
  1351.         
  1352.         '对方汇总数的借贷方向
  1353.         SqlStr = "Select ccode,TranOri from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=0 Order by AutoTranId"
  1354.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1355.         If Rec_AutoTranItem.EOF = False Then
  1356.             DestTranOri = Rec_AutoTranItem.Fields("tranori")
  1357.         End If
  1358.         
  1359.         Jhj = 0
  1360.         Dhj = 0   '对方汇总金额
  1361.         Jhjsl = 0
  1362.         Dhjsl = 0
  1363.         JhjItemSl = 0
  1364.         DhjItemSl = 0
  1365.         i = 0
  1366.         hjje = 0      '合计金额
  1367.         '按转帐定义关系，取每笔转帐数据，写入临时数据辅表中
  1368.         SqlStr = "select * from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=1 ORDER BY AutoTranId"
  1369.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1370.         Do While Rec_AutoTranItem.EOF = False
  1371.             
  1372.             Str_Formula = Trim(Rec_AutoTranItem.Fields("ccode"))
  1373.             Str_ForeignCode = Trim(Rec_AutoTranItem.Fields("ForeigncurrCode"))
  1374.             
  1375.             If RecTemp.State = 1 Then RecTemp.Close
  1376.             SqlStr = "select AdjustRate from Gy_ForeignCurrency where ForeignCurrCode='" & Str_ForeignCode & "'"
  1377.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1378.             If RecTemp.EOF = False Then
  1379.                 Dec_AdjustRate = RecTemp.Fields("AdjustRate")
  1380.             End If
  1381.             
  1382.             If RecTemp.State = 1 Then RecTemp.Close
  1383.             SqlStr = "select ccode,qmye,qmwb from Cwzz_AccSum where ccode='" & Str_Formula & "' and year=" & Xtyear & " and period=" & Xtmm
  1384.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1385.             If RecTemp.EOF = False Then
  1386.                 Je = RecTemp.Fields("qmwb") * Dec_AdjustRate - RecTemp.Fields("qmye")
  1387.                 Je = Je * IIf(Rec_AutoTranItem.Fields("tranori") = Rec_AutoTranItem.Fields("BalanceOri"), 1, -1)
  1388.                 Dhj = Dhj + Je * IIf(Rec_AutoTranItem.Fields("tranori") = DestTranOri, -1, 1)
  1389.                 
  1390.                 '写临时凭证辅表
  1391.                 If Je <> 0 Then
  1392.                     Call Save_TempPz_Ass(lng_OperationNum, i, Trim(Rec_AutoTranItem.Fields("Digest")), Trim(Rec_AutoTranItem.Fields("Ccode")), Trim(Rec_AutoTranItem.Fields("DeptCode") & ""), Trim(Rec_AutoTranItem.Fields("PersonCode") & ""), Trim(Rec_AutoTranItem.Fields("CusCode") & ""), Trim(Rec_AutoTranItem.Fields("Suppliercode") & ""), Trim(Rec_AutoTranItem.Fields("ItemCode") & ""), Trim(Rec_AutoTranItem.Fields("TranOri")))
  1393.                 End If
  1394.             End If
  1395.             Rec_AutoTranItem.MoveNext
  1396.             i = i + 1
  1397.             hjje = hjje + Je
  1398.         Loop
  1399.         
  1400.         '对方汇总
  1401.         SqlStr = "Select ccode,TranOri from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=0 Order by AutoTranId"
  1402.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1403.         If Rec_AutoTranItem.EOF = False Then
  1404.             DestTranOri = Rec_AutoTranItem.Fields("tranori")
  1405.         End If
  1406.         
  1407.         '找到数据来源为对方汇总数的转帐关系
  1408.         SqlStr = "select * from Cwzz_V_AutoItemAccCode where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and ForeignFlag=0 ORDER BY AutoTranId"
  1409.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1410.         Do While Rec_AutoTranItem.EOF = False
  1411.             
  1412.             Je = Dhj
  1413.             Call Save_TempPz_Ass(lng_OperationNum, i, Trim(Rec_AutoTranItem.Fields("Digest")), Trim(Rec_AutoTranItem.Fields("Ccode")), Trim(Rec_AutoTranItem.Fields("DeptCode") & ""), Trim(Rec_AutoTranItem.Fields("PersonCode") & ""), Trim(Rec_AutoTranItem.Fields("CusCode") & ""), Trim(Rec_AutoTranItem.Fields("Suppliercode") & ""), Trim(Rec_AutoTranItem.Fields("ItemCode") & ""), Trim(Rec_AutoTranItem.Fields("TranOri")))
  1414.             Rec_AutoTranItem.MoveNext
  1415.         Loop
  1416.         If Dhj = 0 Then
  1417.             '删除空凭证主从表
  1418.             Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchSubTemp Where VouchId=lng_OperationNum"
  1419.             Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchMainTemp Where VouchId=lng_OperationNum"
  1420.         End If
  1421.         
  1422.         If hjje = 0 Then              '合计金额
  1423.             '删除空凭证主从表
  1424.             SqlStr = "Delete From Cwzz_AccVouchSubTemp Where VouchId=" & lng_OperationNum
  1425.             Cw_DataEnvi.DataConnect.Execute SqlStr
  1426.             SqlStr = "Delete From Cwzz_AccVouchMainTemp Where VouchId=" & lng_OperationNum
  1427.             Cw_DataEnvi.DataConnect.Execute SqlStr
  1428.             VoidStr = VoidStr + Str(jsq) + " "
  1429.             TranCount = TranCount - 1
  1430.         End If
  1431.         
  1432.     Next jsq
  1433.     
  1434.     Cw_DataEnvi.DataConnect.CommitTrans
  1435.     
  1436.     '没有有效凭证生成，即金额、数量均为0
  1437.     If Len(VoidStr) <> 0 Then
  1438.         Tsxx = "第" & VoidStr & "张凭证没有发生额，不需要结转!"
  1439.         Call Xtxxts(Tsxx, 0, 4)
  1440.     End If
  1441.     
  1442.     If TranCount > 0 Then       '记录生成凭证的个数
  1443.         '记录此次转帐的批号,做为凭证窗体调用的参数
  1444.         AutoTran_PzFrm.Lab_OperNum.Caption = OperationNum
  1445.         
  1446.         '调入凭证制作窗体
  1447.         AutoTran_PzFrm.Show 1
  1448.         
  1449.         
  1450.         '为在转帐过程列表的网格中重新显示制单日期和操作员，防止虽转完，但无痕迹
  1451.         Call Write_Date
  1452.         Call Clean
  1453.     End If
  1454.     Call Cxnrtcwg
  1455.     Exit Sub
  1456.     
  1457. Err1:
  1458.     Cw_DataEnvi.DataConnect.RollbackTrans
  1459.     'Tsxx = "转帐过程中出现未知错误,程序自动恢复保存前状态!"
  1460.     Tsxx = Err.Description
  1461.     Call Xtxxts(Tsxx, 0, 1)
  1462.     Exit Sub
  1463.     
  1464. End Sub
  1467. Public Sub Balance(TjMain As String, TjList As String, TjAss As String) '期末余额子过程
  1468.     
  1469.     Je = 0
  1470.     Sl = 0
  1471.     ItemSl = 0
  1472.     
  1473.     '[从科目总帐或辅助帐取年初余额
  1474.     If TjAss = "" Then
  1475.         SqlStr = "select * from  Cwzz_AccSum  where " & TjMain & " and Year='" & Int_Year & "' and period='" & Xtmm & " '"                          '从科目总帐取月初余额"
  1476.     Else
  1477.         SqlStr = "select * from Cwzz_AccSumAssi  where " & TjMain & "and " & TjAss & " and Year='" & Int_Year & "'   and period='" & Xtmm & " '"    '从辅助总帐取年初余额
  1478.     End If
  1479.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1480.     
  1481.     '余额赋初值
  1482.     If RecTemp.EOF = False Then
  1483.         Je = Trim(RecTemp.Fields("qcye") & "") '改为本月期初余额(bsj 2001-10-16)
  1484.         Sl = Trim(RecTemp.Fields("qcsl") & "") '改为本月期初余额(bsj 2001-10-16)
  1485.         
  1486.         If TjAss <> "" Then
  1487.             ItemSl = Trim(RecTemp.Fields("YcItemsl") & "")
  1488.         End If
  1489.     End If
  1490.     '[从科目总帐或辅助帐取年初余额
  1491.     
  1492.     
  1493.     '[从凭证明细取累计借方贷方发生额计算期末余额
  1494.     SqlStr = "SELECT ccode,Debi_Je=Sum(Jfje),Debi_Sl=Sum(Jfsl),Debi_Itemsl=sum(Itemjfsl),Lender_Je=Sum(Dfje),Lender_Sl=Sum(dfsl)," & _
  1495.     "Lender_Itemsl=sum(ItemDfsl) FROM Cwzz_V_AccVouch "
  1496.     
  1497.     If TjAss = "" Then                                  '无辅助项目核算
  1498.         SqlStr = SqlStr + " where " & TjList & ""
  1499.     Else
  1500.         SqlStr = SqlStr + " Where " & TjList & " and " & TjAss & ""
  1501.     End If
  1502.     
  1503.     '若不包含未记帐凭证，再增加一个限制
  1504.     If Chk_Vouch.Value = 0 Then
  1505.         SqlStr = SqlStr & " and BookFlag='1' "
  1506.     End If
  1507.     
  1508.     SqlStr = SqlStr + " and Year='" & Int_Year & "'  and Period='" & Int_Period & "' group by ccode " '(取本月数 bsj 2001-10-16)
  1509.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1510.     
  1511.     '计算期末余额
  1512.     If RecTemp.EOF = False Then
  1513.         Do While RecTemp.EOF = False
  1514.             Je = Je + Val(RecTemp.Fields("Debi_je") & "") - Val(RecTemp.Fields("Lender_je") & "")
  1515.             Sl = Sl + Val(RecTemp.Fields("Debi_sl") & "") - Val(RecTemp.Fields("Lender_sl") & "")
  1516.             If TjAss <> "" Then
  1517.                 ItemSl = ItemSl + Val(RecTemp.Fields("Debi_Itemsl") & "") - Val(RecTemp.Fields("Lender_Itemsl") & "")
  1518.             End If
  1519.             RecTemp.MoveNext
  1520.         Loop
  1521.     End If
  1522.     ']从凭证明细取累计借方贷方发生额计算期末余额
  1523.     
  1524. End Sub
  1526. Public Sub Debi(TjList As String, TjAss As String)       ''从凭证明细帐求本期借方发生额
  1527.     'TjList为计算明细帐发生额的条件，TjAss 有辅助项目核算的条件
  1528.     Je = 0
  1529.     Sl = 0
  1530.     ItemSl = 0
  1531.     
  1532.     SqlStr = "SELECT Debi_Je=Sum(Jfje),Debi_Sl=Sum(Jfsl),Debi_Itemsl=sum(Itemjfsl) " & _
  1533.     "FROM Cwzz_V_AccVouch "
  1534.     If TjAss = "" Then
  1535.         SqlStr = SqlStr + "where " & TjList & " "
  1536.     Else
  1537.         SqlStr = SqlStr + "where " & TjList & " and " & TjAss & " "
  1538.     End If
  1539.     If Chk_Vouch.Value = 0 Then         '不包含未记帐凭证
  1540.         SqlStr = SqlStr & " and BookFlag='1'"
  1541.     End If
  1542.     SqlStr = SqlStr + " and Year='" & Int_Year & "'  and Period='" & Int_Period & "' Group by Ccode"
  1543.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1544.     If RecTemp.EOF = False Then
  1545.         Do While RecTemp.EOF = False
  1546.             Je = Je + Val(RecTemp.Fields("Debi_Je") & "")
  1547.             Sl = Sl + Val(RecTemp.Fields("Debi_Sl") & "")
  1548.             ItemSl = ItemSl + Val(RecTemp.Fields("Debi_ItemSl") & "")
  1549.             RecTemp.MoveNext
  1550.         Loop
  1551.     End If
  1552. End Sub
  1554. Public Sub Lender(TjList As String, TjAss As String)        ''从凭证明细帐求本期贷方发生额
  1555.     'TjList为计算明细帐发生额的条件，TjAss 有辅助项目核算的条件
  1556.     Je = 0
  1557.     Sl = 0
  1558.     ItemSl = 0
  1559.     
  1560.     SqlStr = "SELECT Lender_Je=Sum(Dfje),Lender_Sl=Sum(Dfsl),Lender_ItemSl=sum(ItemDfsl) " & _
  1561.     "FROM Cwzz_V_AccVouch "
  1562.     If TjAss = "" Then
  1563.         SqlStr = SqlStr + "where " & TjList & " "
  1564.     Else
  1565.         SqlStr = SqlStr + "where " & TjList & " and " & TjAss & " "
  1566.     End If
  1567.     If Chk_Vouch.Value = 0 Then         '不包含未记帐凭证
  1568.         SqlStr = SqlStr & " and BookFlag='1'"
  1569.     End If
  1570.     SqlStr = SqlStr + " and Year='" & Int_Year & "'  and Period='" & Int_Period & "' Group by Ccode"
  1571.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1572.     If RecTemp.EOF = False Then
  1573.         Do While RecTemp.EOF = False
  1574.             Je = Je + Val(RecTemp.Fields("Lender_Je") & "")
  1575.             Sl = Sl + Val(RecTemp.Fields("Lender_Sl") & "")
  1576.             ItemSl = ItemSl + Val(RecTemp.Fields("Lender_ItemSl") & "")
  1577.             RecTemp.MoveNext
  1578.         Loop
  1579.     End If
  1580. End Sub
  1582. Public Sub Balance_Sy(TjMain As String, TjList As String, TjAss As String) '期间损益结转，以明细帐为循环体求总帐中不符合条件的科目期末余额
  1583.     'TjMain为取年初余额的条件，TjList为计算明细帐发生额的条件，TjAss 有辅助项目核算的条件
  1584.     'Je表示期末余额，Sl表示期末余数量
  1585.     Je = 0
  1586.     Sl = 0
  1587.     ItemSl = 0
  1588.     
  1589.     '[从凭证明细取累计借方、贷方发生额等
  1590.     SqlStr = "SELECT ccode,Debi_Je=Sum(Jfje),Debi_Sl=Sum(Jfsl),Lender_Je=Sum(Dfje),Lender_Sl=Sum(dfsl) FROM Cwzz_V_AccVouch "
  1591.     
  1592.     If TjAss = "" Then         '无辅助项目核算时
  1593.         SqlStr = SqlStr + "Where " & TjList & " "
  1594.     Else
  1595.         SqlStr = SqlStr + "Where " & TjList & " and " & TjAss & " "
  1596.     End If
  1597.     
  1598.     '若不包含未记帐凭证，再增加一个限制
  1599.     If Chk_Vouch.Value = 0 Then
  1600.         SqlStr = SqlStr & " and BookFlag='1'"
  1601.     End If
  1602.     SqlStr = SqlStr + " and Year='" & Int_Year & "'  and Period<='" & Int_Period & "' group by ccode "
  1603.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1604.     
  1605.     '计算期末余额
  1606.     If RecTemp.EOF = False Then
  1607.         Je = Je + Val(RecTemp.Fields("Debi_je") & "") - Val(RecTemp.Fields("Lender_je") & "")
  1608.         Sl = Sl + Val(RecTemp.Fields("Debi_sl") & "") - Val(RecTemp.Fields("Lender_sl") & "")
  1609.     End If
  1610.     
  1611.     '再搜索总帐中是否存在该辅助条件的记录,若存在则不参与计算,因为在上面的明细帐汇总时已经计算过,需要剔除掉.
  1612.     If TjAss = "" Then
  1613.         SqlStr = "SELECT * from  Cwzz_AccSum  where " & TjMain & " and Year='" & Int_Year & "' and period=1 " '从科目总帐取年初余额"
  1614.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1615.     Else
  1616.         SqlStr = "select * from Cwzz_AccSumAssi  where " & TjMain & "and " & TjAss & " and Year='" & Int_Year & "' and period=1"    '从辅助总帐取年初余额
  1617.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1618.     End If
  1619.     If RecTemp.EOF = False Then
  1620.         Je = 0
  1621.         Sl = 0
  1622.     End If
  1623. End Sub
  1626. Private Sub Save_TempPz_Main(TranVouchClass1 As String, TranNo As String, OperationNum1 As Integer, VouchIdTemp_Id As Long) '将有效数据写入临时凭证主表。（先写辅表再写主表，为了防止在主表中写入没有发生额的空凭证记录）
  1627.     Dim Rec_VouchMainTemp As New ADODB.Recordset           '临时凭证主表记录集
  1628.     
  1629.     '打开临时凭证主表，用于存放有效凭证的凭证号等信息
  1630.     If Rec_VouchMainTemp.State = 1 Then Rec_VouchMainTemp.Close
  1631.     Rec_VouchMainTemp.Open "select * from Cwzz_AccVouchMainTemp Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1632.     With Rec_VouchMainTemp
  1633.         .AddNew
  1634.         .Fields("VouchId") = VouchIdTemp_Id              '转帐过程序号
  1635.         .Fields("Year") = Int_Year                           '取选中的年份
  1636.         .Fields("period") = Int_Period                       '取选中的会计期间
  1637.         .Fields("Ddate") = Xtrq                              '取系统日期
  1638.         .Fields("VouchClassCode") = TranVouchClass1          '所转转帐过程的凭证类别
  1639.         .Fields("Doc") = 0
  1640.         .Fields("Bill") = Xtczy
  1641.         .Fields("VouchSource") = "自动转帐"                  '凭证来源
  1642.         .Fields("OperationClass") = ""                       '业务类型
  1643.         .Fields("BillType") = ""
  1644.         .Fields("BillNo") = TranNo                           '存放转帐过程编码
  1645.         .Fields("OperationNo") = OperationNum1               '存放批号
  1646.         .Fields("DeleteFlag") = IIf(Bln_DeleteFlag, 1, 0)
  1647.         
  1648.         .Update
  1649.     End With
  1650. End Sub
  1652. Private Function Tran_Pd() As Boolean            '转帐之前的判断
  1653.     Dim jsq As Long             '临时计数器
  1654.     '提示已转过的凭证是否再转一次
  1655.     With CzxsGrid
  1656.         For jsq = .FixedRows To .Rows - 1
  1657.             If .TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = "√" Then
  1658.                 If .TextMatrix(jsq, Sydz("005", GridStr(), Szzls)) <> "" Then
  1659.                     Tsxx = "第" & CzxsGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) & "号已转过凭证，再转一次吗？"
  1660.                     If Xtxxts(Tsxx, 1, 4) = 7 Then
  1661.                         .TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = ""
  1662.                     End If
  1663.                 End If
  1664.             End If
  1665.         Next jsq
  1666.     End With
  1667.     
  1668.     '判断选择的转帐过程共几个，保存在TranJsq中。将每个转帐过程编号赋值到TranNum（）数组中，
  1669.     ReDim TranNum(1)                            '转帐过程数组附初值
  1670.     TranJsq = 0
  1671.     With CzxsGrid
  1672.         For jsq = .FixedRows To .Rows - 1
  1673.             If .TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = "√" Then
  1674.                 If TranJsq = 0 Then
  1675.                     TranNum(1) = .TextMatrix(jsq, Sydz("001", GridStr(), Szzls))
  1676.                 End If
  1677.                 If TranJsq > 0 Then
  1678.                     ReDim Preserve TranNum(UBound(TranNum) + 1)
  1679.                     TranNum(TranJsq + 1) = .TextMatrix(jsq, Sydz("001", GridStr(), Szzls))
  1680.                 End If
  1681.                 TranJsq = TranJsq + 1
  1682.             End If
  1683.         Next jsq
  1684.     End With
  1685.     If TranJsq = 0 Then
  1686.         Tsxx = "没有选择转帐过程!"
  1687.         Call Xtxxts(Tsxx, 0, 4)
  1688.         Tran_Pd = False
  1689.         Exit Function
  1690.     End If
  1691.     Jsq_Eff = TranJsq               '假设选择的转帐过程全部有效
  1692.     
  1693.     '将每个转帐过程的凭证类别放到数组TranVouchClass中
  1694.     ReDim TranVouchClass(1)
  1695.     For jsq = 1 To TranJsq
  1696.         SqlStr = "SELECT * FROM Cwzz_AutoTranMain where TranCode='" & TranNum(jsq) & "'and tranclass='" & TranClassCode & "'"
  1697.         Set Rec_AutoTranMain = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1698.         If jsq > 1 Then
  1699.             ReDim Preserve TranVouchClass(UBound(TranVouchClass) + 1)
  1700.         End If
  1701.         TranVouchClass(jsq) = Trim(Rec_AutoTranMain.Fields("VouchClassCode") & "")
  1702.     Next jsq
  1703.     
  1704.     '取操作批号OperationNum，需唯一。
  1705.     OperationNum = CreatBillID("0102")
  1706.     RecTemp.Close
  1707.     Tran_Pd = True
  1708. End Function
  1711. Private Sub Write_Date()    '写转帐日期
  1712.     Dim RecTran As ADODB.Recordset
  1713.     Set RecTran = Cw_DataEnvi.DataConnect.Execute("Select * from Cwzz_AccVouchMainTemp where OperationNo='" & OperationNum & "' and VouchNo is not null and VouchNo<>'' ")
  1714.     If RecTran.EOF = False Then
  1715.         Do While RecTran.EOF = False
  1716.             If RecTemp.State = 1 Then RecTemp.Close
  1717.             RecTemp.Open "select * from Cwzz_AutoTranMain where TranCode='" & Trim(RecTran.Fields("BillNo")) & "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1718.             RecTemp.Fields("EndTranDate") = Xtrq
  1719.             RecTemp.Fields("Bill") = Xtczy
  1720.             RecTemp.Update
  1721.             RecTemp.Close
  1722.             RecTran.MoveNext
  1723.         Loop
  1724.     End If
  1725. End Sub
  1727. Private Sub Clean()               '删除临时数据表数据
  1728.     If Bln_DeleteFlag = True Then
  1729.         If RecTemp.State = 1 Then RecTemp.Close
  1730.         '删除临时凭证主从表
  1731.         Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchSubTemp Where VouchId in (select VouchId from Cwzz_AccVouchMainTemp where OperationNo='" & OperationNum & "')"
  1732.         Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchMainTemp Where OperationNo='" & OperationNum & "'"
  1733.     End If
  1734. End Sub
  1736. Private Sub Run5()    '执行模式转帐程序
  1737.     
  1738.     Dim jsq As Integer                                      '临时计数器
  1739.     Dim serialno As Integer
  1740.     Dim lng_OperationNum As Long
  1741.     Bln_DeleteFlag = True
  1742.     
  1743.     If Tran_Pd = False Then
  1744.         Exit Sub
  1745.     End If
  1746.     
  1747.     On Error GoTo Err1
  1748.     Cw_DataEnvi.DataConnect.BeginTrans
  1749.     
  1750.     TranCount = TranJsq          '记录生成凭证的个数
  1751.     VoidStr = ""         '记录没有数值的空凭证序号
  1752.     
  1753.     '对转帐列表网格内选中的TranJsq个转帐过程依次生成凭证，写到临时凭证数据表中
  1754.     For jsq = 1 To TranJsq
  1755.         
  1756.         '定位转帐定义辅表，找到转帐编码为TranNum(jsq)的转帐关系
  1757.         SqlStr = "select * from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' Order by AutoTranId "
  1758.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1759.         If Rec_AutoTranItem.EOF = True Then
  1760.             Jsq_Eff = Jsq_Eff - 1
  1761.         Else
  1762.             Jhj = 0
  1763.             Dhj = 0
  1764.             hjje = 0      '合计金额
  1765.             '写临时凭证主表
  1766.             lng_OperationNum = CreatBillID("0102")
  1767.             Call Save_TempPz_Main(TranVouchClass(jsq), TranNum(jsq), OperationNum, lng_OperationNum)
  1768.             
  1769.             '按转帐定义关系，取每笔转帐数据，写入临时数据辅表中
  1770.             serialno = 1
  1771.             Do While Rec_AutoTranItem.EOF = False
  1772.                 Je = Round(Rec_AutoTranItem.Fields("Constant") * Rec_AutoTranItem.Fields("DistriProp") / 100, Xtjexsws)
  1773.                 '写临时凭证辅表
  1774.                 Call Save_TempPz_Ass(lng_OperationNum, serialno, Rec_AutoTranItem.Fields("Digest"), Rec_AutoTranItem.Fields("Ccode"), Trim(Rec_AutoTranItem.Fields("DeptCode") & ""), Trim(Rec_AutoTranItem.Fields("PersonCode") & ""), Trim(Rec_AutoTranItem.Fields("CusCode") & ""), Trim(Rec_AutoTranItem.Fields("Suppliercode") & ""), Trim(Rec_AutoTranItem.Fields("ItemCode") & ""), Trim(Rec_AutoTranItem.Fields("TranOri")))
  1775.                 Rec_AutoTranItem.MoveNext
  1776.                 serialno = serialno + 1
  1777.                 hjje = hjje + Je
  1778.             Loop
  1779.             
  1780.         End If
  1781.         
  1782.         If hjje = 0 Then              '合计金额
  1783.             '删除空凭证主从表
  1784.             SqlStr = "Delete From Cwzz_AccVouchSubTemp Where VouchId=" & lng_OperationNum
  1785.             Cw_DataEnvi.DataConnect.Execute SqlStr
  1786.             SqlStr = "Delete From Cwzz_AccVouchMainTemp Where VouchId=" & lng_OperationNum
  1787.             Cw_DataEnvi.DataConnect.Execute SqlStr
  1788.             VoidStr = VoidStr + Str(jsq) + " "
  1789.             TranCount = TranCount - 1
  1790.         End If
  1791.         
  1792.     Next jsq
  1793.     
  1794.     Cw_DataEnvi.DataConnect.CommitTrans
  1795.     
  1796.     '没有有效凭证生成，即金额、数量均为0
  1797.     If Len(VoidStr) <> 0 Then
  1798.         Tsxx = "第" & VoidStr & "张凭证没有发生额，不需要结转!"
  1799.         Call Xtxxts(Tsxx, 0, 4)
  1800.     End If
  1801.     
  1802.     If TranCount > 0 Then       '记录生成凭证的个数
  1803.         '记录此次转帐的批号,做为凭证窗体调用的参数
  1804.         AutoTran_PzFrm.Lab_OperNum.Caption = OperationNum
  1805.         
  1806.         '调入凭证制作窗体
  1807.         AutoTran_PzFrm.Show 1
  1808.         
  1809.         
  1810.         '为在转帐过程列表的网格中重新显示制单日期和操作员，防止虽转完，但无痕迹
  1811.         Call Write_Date
  1812.         Call Clean
  1813.     End If
  1814.     Call Cxnrtcwg
  1815.     Exit Sub
  1816.     
  1817. Err1:
  1818.     Cw_DataEnvi.DataConnect.RollbackTrans
  1819.     'Tsxx = "转帐过程中出现未知错误,程序自动恢复保存前状态!"
  1820.     Tsxx = Err.Description
  1821.     Call Xtxxts(Tsxx, 0, 1)
  1822.     Exit Sub
  1823.     
  1824. End Sub
  1826. Private Sub Save_TempPz_Ass(VouchIdTemp_Id As Long, serialnum As Integer, Str_Digest As String, Str_Kmh As String, Str_Dept As String, Str_Per As String, Str_Cus As String, Str_Sup As String, Str_Item As String, str_TranOri As String) '写临时凭证辅表
  1827.     'VouchIdTemp_Id临时凭证主表、辅表对应关系Id号
  1828.     Dim Rec_VouchTemp As New ADODB.Recordset            '临时凭证辅表记录集
  1829.     
  1830.     '打开临时凭证辅表,用于存放转帐凭证内容
  1831.     Rec_VouchTemp.Open "select * from Cwzz_AccVouchsubTemp where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1832.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * from Cwzz_AccCode where Ccode='" & Str_Kmh & "'")
  1833.     With Rec_VouchTemp
  1834.         .AddNew
  1835.         
  1836.         '[公共信息
  1837.         If str_TranOri = "贷" Then                               '若记入借方
  1838.             .Fields("Dfje") = Je                                 '贷方金额
  1839.             .Fields("Jfje") = 0
  1840.             .Fields("Jfsl") = 0
  1841.         Else
  1842.             .Fields("Jfje") = Je                                 '借方金额
  1843.             .Fields("Dfje") = 0
  1844.             .Fields("Dfsl") = 0
  1845.         End If
  1846.         .Fields("Digest") = Str_Digest                           '摘要
  1847.         .Fields("Ccode") = Str_Kmh                               '转帐科目号
  1848.         .Fields("VouchId") = VouchIdTemp_Id                  '与主表的对应ID
  1849.         .Fields("serialID") = serialnum                  '序号ID
  1850.         
  1851.         ']公共信息
  1852.         
  1853.         If RecTemp.EOF = True Then
  1854.             Exit Sub
  1855.         End If
  1856.         
  1857.         '[数量信息
  1858.         If RecTemp.Fields("QuantityFlag") = True Then
  1859.             If str_TranOri = "贷" Then
  1860.                 .Fields("Dfsl") = Sl                          '贷方数量
  1861.                 .Fields("Jfsl") = 0
  1862.             Else
  1863.                 .Fields("Dfsl") = 0
  1864.                 .Fields("Jfsl") = Sl
  1865.             End If
  1866.         Else
  1867.             .Fields("Jfsl") = 0
  1868.             .Fields("Dfsl") = 0
  1869.         End If
  1870.         ']数量信息
  1871.         
  1872.         
  1873.         '[项目信息
  1874.         If RecTemp.Fields("ItemFlag") = True Then
  1875.             If str_TranOri = "贷" Then
  1876.                 .Fields("ItemDfsl") = ItemSl
  1877.                 .Fields("ItemJfsl") = 0
  1878.             Else
  1879.                 .Fields("ItemDfsl") = 0
  1880.                 .Fields("ItemJfsl") = ItemSl
  1881.             End If
  1882.             .Fields("ItemClassCode") = RecTemp.Fields("ItemClassCode")
  1883.             .Fields("ItemCode") = Str_Item
  1884.         Else
  1885.             .Fields("ItemJfsl") = 0
  1886.             .Fields("ItemDfsl") = 0
  1887.         End If
  1888.         ']项目信息
  1889.         
  1890.         '[辅助信息
  1891.         If RecTemp.Fields("PersonFlag") = True Then
  1892.             .Fields("PersonCode") = Str_Per                              '个人
  1893.         End If
  1894.         If RecTemp.Fields("DeptFlag") = True Then
  1895.             .Fields("DeptCode") = Str_Dept                           '部门
  1896.         End If
  1897.         If RecTemp.Fields("CusFlag") = True Then
  1898.             .Fields("CusCode") = Str_Cus                                  '客户
  1899.         End If
  1900.         If RecTemp.Fields("SupplierFlag") = True Then
  1901.             .Fields("Suppliercode") = Str_Sup                           '供应商
  1902.         End If
  1903.         ']辅助信息
  1904.         
  1905.         
  1906.         '[币别信息
  1907.         .Fields("AccRate") = 1
  1908.         .Fields("ForeignCurrCode") = XtSCurrCode
  1909.         If str_TranOri = "贷" Then                               '若记入借方
  1910.             .Fields("WbDfje") = Je
  1911.             .Fields("WbJfje") = 0
  1912.         Else
  1913.             .Fields("WbJfje") = Je
  1914.             .Fields("WbDfje") = 0
  1915.         End If
  1916.         ']币别信息
  1917.         
  1918.         '[银行结算信息
  1919.         .Fields("SScode") = ""
  1920.         .Fields("BillNo") = ""
  1921.         .Fields("TranPerson") = ""
  1922.         ']银行结算信息
  1923.         
  1924.         .Update
  1925.     End With
  1926. End Sub
  1928. Private Sub Run4()      '期间损益结转、管理费用差额结转
  1929.     
  1930.     Dim Tj_Main As String                                   '总帐取数公式
  1931.     Dim Tj_List As String                                   '明细帐取数公式
  1932.     Dim Tj_Ass As String                                    '辅助帐取数公式
  1933.     
  1934.     Dim jsq As Integer                                      '临时计数器
  1935.     Dim i As Integer                                        '凭证序列号
  1936.     
  1937.     Dim Rec_AccCcode As New ADODB.Recordset                 '会计科目记录集
  1938.     Dim Rec_AccAss As New ADODB.Recordset                   '总辅助帐
  1939.     Dim Rec_AccList As New ADODB.Recordset                  '明细帐
  1940.     Dim RecAssType As ADODB.Recordset                       '判断转帐科目有几种辅助核算时用
  1941.     Dim lng_OperationNum As Long
  1942.     Bln_DeleteFlag = True
  1943.     
  1944.     If Tran_Pd = False Then
  1945.         Exit Sub
  1946.     End If
  1947.     
  1948.     On Error GoTo Err1
  1949.     Cw_DataEnvi.DataConnect.BeginTrans
  1950.     
  1951.     TranCount = TranJsq          '记录生成凭证的个数
  1952.     VoidStr = ""         '记录没有数值的空凭证序号
  1953.     
  1954.     '对转帐列表网格内选中的TranJsq个转帐过程依次生成凭证，写到临时凭证数据表中
  1955.     For jsq = 1 To TranJsq
  1956.         
  1957.         'VouchIdTemp=jsq + OperationNum 为了确保VouchIdTemp每次生成时唯一
  1958.         '借方或贷方有有效数据时,写临时凭证主表,否则有效转帐过程-1
  1959.         
  1960.         lng_OperationNum = CreatBillID("0102")
  1961.         Call Save_TempPz_Main(TranVouchClass(jsq), TranNum(jsq), OperationNum, lng_OperationNum)
  1962.         
  1963.         '定位转帐定义辅表，找到转帐编码为TranNum(jsq)的转帐关系(把对方汇总数除外）
  1964.         SqlStr = "select * from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaCode<>'05' order by AutoTranId"
  1965.         Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1966.         i = 1
  1967.         If Rec_AutoTranItem.EOF = False Then
  1968.             Jhj = 0
  1969.             Dhj = 0
  1970.             Jhjsl = 0
  1971.             Dhjsl = 0
  1972.             hjje = 0      '合计金额
  1973.             Do While Rec_AutoTranItem.EOF = False                           '转帐关系定义数据记录集
  1974.                 Tj_Main = "Ccode='" & Trim(Rec_AutoTranItem.Fields("GetCcode") & "") & "'"
  1975.                 Tj_List = Tj_Main
  1976.                 
  1977.                 SqlStr = "Select * from Cwzz_AccCode Where " & Tj_Main & ""
  1978.                 Set RecAssType = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1979.                 If RecAssType.EOF = False Then                           '转帐科目是否存在
  1980.                     If RecAssType.Fields("stopflag") <> True Then         '若该科目没有停用
  1981.                         '若该科目不参与任何辅助核算
  1982.                         If Trim(RecAssType.Fields("DeptFlag") & "") <> True And Trim(RecAssType.Fields("PersonFlag") & "") <> True And Trim(RecAssType.Fields("CusFlag") & "") <> True And Trim(RecAssType.Fields("SupplierFlag") & "") <> True And Trim(RecAssType.Fields("ItemFlag") & "") <> True Then
  1983.                             TjAss = ""
  1984.                             Call Balance(Tj_Main, Tj_List, Tj_Ass)
  1985.                             If Rec_AutoTranItem.Fields("TranOri") = "借" Then
  1986.                                 Je = -Je
  1987.                                 Sl = -Sl
  1988.                                 ItemSl = -ItemSl
  1989.                             End If
  1990.                             If Je <> 0 Or SJ <> 0 Or ItemSl <> 0 Then
  1991.                                 If Rec_AutoTranItem.Fields("TranOri") = "借" Then
  1992.                                     Jhj = Jhj + Je
  1993.                                 Else
  1994.                                     Dhj = Dhj + Je
  1995.                                 End If
  1996.                                 Call Save_TempPz_Ass(lng_OperationNum, i, Rec_AutoTranItem.Fields("Digest"), Rec_AutoTranItem.Fields("Ccode"), "", "", "", "", "", Rec_AutoTranItem.Fields("TranOri"))
  1997.                                 i = i + 1
  1998.                             End If
  1999.                         Else
  2000.                             If Chk_Vouch.Value = 1 Then   '包含未记帐凭证
  2001.                                 SqlStr = " SELECT DeptCode, PersonCode, CusCode, Suppliercode, ItemClassCode, ItemCode,b.Qmye , b.Qmsl, b.QmItemSl From " & _
  2002.                                 "(SELECT DeptCode, PersonCode, CusCode, Suppliercode, ItemClassCode,ItemCode, Qmye = SUM(YcyeHj + Jfljjehj - Dfljjehj),Qmsl = SUM(Ycslhj + Jfljslhj - Dfljslhj),QmItemSl = Sum(YcItemslHj + JfljItemslhj - DfljItemslhj) From " & _
  2003.                                 "((SELECT DeptCode, PersonCode, CusCode, Suppliercode, ItemClassCode,ItemCode, YcyeHj = SUM(Ycye), Ycslhj = SUM(Ycsl),YcItemSlHj = SUM(YcItemSl), JfljjeHj = 0, Dfljjehj = 0, Jfljslhj = 0,Dfljslhj = 0, JfljItemslhj = 0, DfljItemslhj = 0 From Cwzz_AccSumAssi " & _
  2004.                                 " WHERE " & Tj_Main & " AND Year ='" & Int_Year & "' AND Period = 1 GROUP BY DeptCode, PersonCode, CusCode, Suppliercode,ItemClassCode, ItemCode) Union All " & _
  2005.                                 "(SELECT DeptCode, PersonCode, CusCode, Suppliercode, ItemClassCode,ItemCode, YcyeHJ = 0, Ycslhj = 0, YcItemslHj = 0, JfljjeHj = SUM(Jfje),Dfljjehj = SUM(Dfje), Jfljslhj = SUM(Jfsl), Dfljslhj = SUM(Dfsl),JfljItemslhj = SUM(ItemJfsl), DfljItemslhj = SUM(ItemDfsl) From Cwzz_V_AccVouch " & _
  2006.                                 " WHERE " & Tj_Main & " AND Year ='" & Int_Year & "' AND Period <='" & Int_Period & "' GROUP BY DeptCode, PersonCode, CusCode, Suppliercode, ItemClassCode,ItemCode)) a GROUP BY DeptCode, PersonCode, CusCode, Suppliercode, ItemClassCode, ItemCode) b ORDER BY DeptCode, PersonCode, CusCode, Suppliercode, ItemClassCode, ItemCode "
  2007.                             Else
  2008.                                 SqlStr = "Select DeptCode,PersonCode,CusCode,Suppliercode,ItemClassCode,ItemCode,Qmye,Qmsl,QmItemSl From  Cwzz_AccSumAssi Where " & Tj_Main & " And Year='" & Int_Year & "' And Period='" & Int_Period & "' order by DeptCode,PersonCode,CusCode,Suppliercode,ItemClassCode,ItemCode"
  2009.                             End If
  2010.                             Set Rec_AccAss = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  2011.                             If Rec_AccAss.EOF = False Then
  2012.                                 Do While Rec_AccAss.EOF = False
  2013.                                     aa = Trim(Rec_AccAss.Fields("DeptCode") & "")
  2014.                                     '计算该科目下的所有部门个人等的期末余额
  2015.                                     Je = Rec_AccAss.Fields("Qmye")
  2016.                                     Sl = Rec_AccAss.Fields("Qmsl")
  2017.                                     ItemSl = Rec_AccAss.Fields("QmItemSl")
  2018.                                     
  2019.                                     If Rec_AutoTranItem.Fields("TranOri") = "借" Then
  2020.                                         Je = -Je
  2021.                                         Sl = -Sl
  2022.                                         ItemSl = -ItemSl
  2023.                                     End If
  2024.                                     '[写临时凭证，并计算借、贷方合计
  2025.                                     If Je <> 0 Or Sl <> 0 Or ItemSl <> 0 Then
  2026.                                         If Rec_AutoTranItem.Fields("TranOri") = "借" Then
  2027.                                             Jhj = Jhj + Je
  2028.                                             Jhjsl = Jhjsl + Sl
  2029.                                         Else
  2030.                                             Dhj = Dhj + Je
  2031.                                             Dhjsl = Dhjsl + Sl
  2032.                                         End If
  2033.                                         Call Save_TempPz_Ass(lng_OperationNum, i, Rec_AutoTranItem.Fields("Digest"), Rec_AutoTranItem.Fields("Ccode"), Trim(Rec_AccAss.Fields("DeptCode") & ""), Trim(Rec_AccAss.Fields("PersonCode") & ""), Trim(Rec_AccAss.Fields("CusCode") & ""), Trim(Rec_AccAss.Fields("Suppliercode") & ""), Trim(Rec_AccAss.Fields("ItemCode") & ""), Rec_AutoTranItem.Fields("TranOri"))
  2034.                                         i = i + 1
  2035.                                     End If
  2036.                                     Rec_AccAss.MoveNext
  2037.                                 Loop
  2038.                             End If      '总辅助帐计算后记录集不为空
  2039.                         End If          '有无辅助核算
  2040.                     End If              '科目没有停用
  2041.                 End If                  '转帐科目是否存在
  2042.                 Rec_AutoTranItem.MoveNext
  2043.                 hjje = hjje + Je
  2044.             Loop
  2045.             
  2046.             '[“对方汇总数”的转帐关系
  2047.             SqlStr = "select * from Cwzz_AutoTranItem where Trancode='" & TranNum(jsq) & "' and TranClass='" & TranClassCode & "' and FormulaCode='05'"
  2048.             Set Rec_AutoTranItem = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  2049.             If Rec_AutoTranItem.EOF = False And Abs(Jhj - Dhj) > 0.001 Then
  2050.                 Je = Jhj - Dhj
  2051.                 If Rec_AutoTranItem.Fields("TranOri") = "借" Then
  2052.                     Je = -Je
  2053.                 End If
  2054.                 Sl = 0
  2055.                 ItemSl = 0
  2056.                 Call Save_TempPz_Ass(lng_OperationNum, i, Rec_AutoTranItem.Fields("Digest"), Rec_AutoTranItem.Fields("Ccode"), Trim(Rec_AutoTranItem.Fields("DeptCode") & ""), Trim(Rec_AutoTranItem.Fields("PersonCode") & ""), Trim(Rec_AutoTranItem.Fields("CusCode") & ""), Trim(Rec_AutoTranItem.Fields("Suppliercode") & ""), Trim(Rec_AutoTranItem.Fields("ItemCode") & ""), Rec_AutoTranItem.Fields("TranOri"))
  2057.                 i = i + 1
  2058.             End If
  2059.             ']“对方汇总数”的转帐关系
  2060.             
  2061.         End If
  2062.         
  2063.         If hjje = 0 Then              '合计金额
  2064.             '删除空凭证主从表
  2065.             SqlStr = "Delete From Cwzz_AccVouchSubTemp Where VouchId=" & lng_OperationNum
  2066.             Cw_DataEnvi.DataConnect.Execute SqlStr
  2067.             SqlStr = "Delete From Cwzz_AccVouchMainTemp Where VouchId=" & lng_OperationNum
  2068.             Cw_DataEnvi.DataConnect.Execute SqlStr
  2069.             VoidStr = VoidStr + Str(jsq) + " "
  2070.             TranCount = TranCount - 1
  2071.         End If
  2072.     Next jsq
  2073.     Cw_DataEnvi.DataConnect.CommitTrans
  2074.     
  2075.     '没有有效凭证生成，即金额、数量均为0
  2076.     If Len(VoidStr) <> 0 Then
  2077.         Tsxx = "第" & VoidStr & "张凭证没有发生额，不需要结转!"
  2078.         Call Xtxxts(Tsxx, 0, 4)
  2079.     End If
  2080.     
  2081.     If TranCount > 0 Then       '记录生成凭证的个数
  2082.         '记录此次转帐的批号,做为凭证窗体调用的参数
  2083.         AutoTran_PzFrm.Lab_OperNum.Caption = OperationNum
  2084.         
  2085.         '调入凭证制作窗体
  2086.         AutoTran_PzFrm.Show 1
  2087.         
  2088.         
  2089.         '为在转帐过程列表的网格中重新显示制单日期和操作员，防止虽转完，但无痕迹
  2090.         Call Write_Date
  2091.         Call Clean
  2092.     End If
  2093.     Call Cxnrtcwg
  2094.     Exit Sub
  2095.     
  2096. Err1:
  2097.     Cw_DataEnvi.DataConnect.RollbackTrans
  2098.     'Tsxx = "转帐过程中出现未知错误,程序自动恢复保存前状态!"
  2099.     Tsxx = Err.Description
  2100.     Call Xtxxts(Tsxx, 0, 1)
  2101.     Exit Sub
  2102.     
  2103. End Sub