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

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

企业管理

开发平台：

Visual Basic

：源码内容
  1. VERSION 5.00
  2. Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form Xs_P_PersonPlan 
  5.    BackColor       =   &H00C0C0C0&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "销售员销售编制计划"
  8.    ClientHeight    =   6990
  9.    ClientLeft      =   675
  10.    ClientTop       =   720
  11.    ClientWidth     =   11400
  12.    Icon            =   "销售员销售计划编制.frx":0000
  13.    KeyPreview      =   -1  'True
  14.    LinkTopic       =   "Form4"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   6990
  18.    ScaleWidth      =   11400
  19.    StartUpPosition =   1  '所有者中心
  20.    Begin VB.CommandButton Ydcommand 
  21.       Height          =   300
  22.       Left            =   11010
  23.       Picture         =   "销售员销售计划编制.frx":1042
  24.       Style           =   1  'Graphical
  25.       TabIndex        =   1
  26.       Top             =   2010
  27.       Visible         =   0   'False
  28.       Width           =   300
  29.    End
  30.    Begin VB.PictureBox Pic_Title 
  31.       BackColor       =   &H00FFFFFF&
  32.       Height          =   855
  33.       Left            =   0
  34.       Picture         =   "销售员销售计划编制.frx":13CC
  35.       ScaleHeight     =   795
  36.       ScaleWidth      =   11715
  37.       TabIndex        =   7
  38.       Top             =   570
  39.       Width           =   11775
  40.       Begin MSComctlLib.ImageList ImageList1 
  41.          Left            =   4260
  42.          Top             =   60
  43.          _ExtentX        =   1005
  44.          _ExtentY        =   1005
  45.          BackColor       =   -2147483643
  46.          ImageWidth      =   16
  47.          ImageHeight     =   16
  48.          MaskColor       =   12632256
  49.          _Version        =   393216
  50.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  51.             NumListImages   =   25
  52.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  53.                Picture         =   "销售员销售计划编制.frx":1E30C
  54.                Key             =   "sz"
  55.             EndProperty
  56.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  57.                Picture         =   "销售员销售计划编制.frx":1E6A6
  58.                Key             =   "dy"
  59.             EndProperty
  60.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  61.                Picture         =   "销售员销售计划编制.frx":1EA40
  62.                Key             =   "yl"
  63.             EndProperty
  64.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  65.                Picture         =   "销售员销售计划编制.frx":1EDDA
  66.                Key             =   "xg"
  67.             EndProperty
  68.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  69.                Picture         =   "销售员销售计划编制.frx":1F174
  70.                Key             =   "zh"
  71.             EndProperty
  72.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  73.                Picture         =   "销售员销售计划编制.frx":1F50E
  74.                Key             =   "sh"
  75.             EndProperty
  76.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  77.                Picture         =   "销售员销售计划编制.frx":1F8A8
  78.                Key             =   "bc"
  79.             EndProperty
  80.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  81.                Picture         =   "销售员销售计划编制.frx":1FC42
  82.                Key             =   "fq"
  83.             EndProperty
  84.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  85.                Picture         =   "销售员销售计划编制.frx":1FFDC
  86.                Key             =   "bz"
  87.             EndProperty
  88.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  89.                Picture         =   "销售员销售计划编制.frx":20376
  90.                Key             =   "tc"
  91.             EndProperty
  92.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  93.                Picture         =   "销售员销售计划编制.frx":20710
  94.                Key             =   "bcgs"
  95.             EndProperty
  96.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  97.                Picture         =   "销售员销售计划编制.frx":20AAA
  98.                Key             =   "mrlk"
  99.             EndProperty
  100.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  101.                Picture         =   "销售员销售计划编制.frx":20E44
  102.                Key             =   "xsxm"
  103.             EndProperty
  104.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  105.                Picture         =   "销售员销售计划编制.frx":211DE
  106.                Key             =   "first"
  107.             EndProperty
  108.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  109.                Picture         =   "销售员销售计划编制.frx":21578
  110.                Key             =   "prev"
  111.             EndProperty
  112.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  113.                Picture         =   "销售员销售计划编制.frx":21912
  114.                Key             =   "next"
  115.             EndProperty
  116.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  117.                Picture         =   "销售员销售计划编制.frx":21CAC
  118.                Key             =   "last"
  119.             EndProperty
  120.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  121.                Picture         =   "销售员销售计划编制.frx":22046
  122.                Key             =   "xx"
  123.             EndProperty
  124.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  125.                Picture         =   "销售员销售计划编制.frx":223E0
  126.                Key             =   "define"
  127.             EndProperty
  128.             BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  129.                Picture         =   "销售员销售计划编制.frx":2277A
  130.                Key             =   "exec"
  131.             EndProperty
  132.             BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  133.                Picture         =   "销售员销售计划编制.frx":22B14
  134.                Key             =   "xz"
  135.             EndProperty
  136.             BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  137.                Picture         =   "销售员销售计划编制.frx":22EAE
  138.                Key             =   "sc"
  139.             EndProperty
  140.             BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  141.                Picture         =   "销售员销售计划编制.frx":23248
  142.                Key             =   "sx"
  143.             EndProperty
  144.             BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  145.                Picture         =   "销售员销售计划编制.frx":235E2
  146.                Key             =   "cx"
  147.             EndProperty
  148.             BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  149.                Picture         =   "销售员销售计划编制.frx":2397C
  150.                Key             =   "zd"
  151.             EndProperty
  152.          EndProperty
  153.       End
  154.       Begin VB.Label Label1 
  155.          AutoSize        =   -1  'True
  156.          BackStyle       =   0  'Transparent
  157.          Height          =   180
  158.          Index           =   3
  159.          Left            =   8520
  160.          TabIndex        =   13
  161.          Top             =   360
  162.          Width           =   90
  163.       End
  164.       Begin VB.Label Label1 
  165.          AutoSize        =   -1  'True
  166.          BackStyle       =   0  'Transparent
  167.          Caption         =   "会计年度:"
  168.          Height          =   180
  169.          Index           =   2
  170.          Left            =   7560
  171.          TabIndex        =   12
  172.          Top             =   360
  173.          Width           =   810
  174.       End
  175.       Begin VB.Label Label1 
  176.          AutoSize        =   -1  'True
  177.          BackStyle       =   0  'Transparent
  178.          Height          =   180
  179.          Index           =   1
  180.          Left            =   5520
  181.          TabIndex        =   11
  182.          Top             =   360
  183.          Width           =   90
  184.       End
  185.       Begin VB.Label Label1 
  186.          AutoSize        =   -1  'True
  187.          BackStyle       =   0  'Transparent
  188.          Caption         =   "部门:"
  189.          Height          =   180
  190.          Index           =   0
  191.          Left            =   5040
  192.          TabIndex        =   10
  193.          Top             =   360
  194.          Width           =   450
  195.       End
  196.       Begin VB.Label Lab_TitleText 
  197.          BackStyle       =   0  'Transparent
  198.          ForeColor       =   &H00FF0000&
  199.          Height          =   225
  200.          Left            =   750
  201.          TabIndex        =   9
  202.          Top             =   690
  203.          Width           =   1455
  204.       End
  205.       Begin VB.Label tsLabel 
  206.          BackColor       =   &H80000018&
  207.          BackStyle       =   0  'Transparent
  208.          Caption         =   "销售员销售计划编制"
  209.          BeginProperty Font 
  210.             Name            =   "宋体"
  211.             Size            =   14.25
  212.             Charset         =   134
  213.             Weight          =   700
  214.             Underline       =   0   'False
  215.             Italic          =   0   'False
  216.             Strikethrough   =   0   'False
  217.          EndProperty
  218.          ForeColor       =   &H00000000&
  219.          Height          =   375
  220.          Index           =   4
  221.          Left            =   510
  222.          TabIndex        =   8
  223.          Top             =   180
  224.          Width           =   2775
  225.       End
  226.    End
  227.    Begin VB.TextBox Ydtext 
  228.       BackColor       =   &H00C0FFFF&
  229.       BorderStyle     =   0  'None
  230.       Height          =   330
  231.       Left            =   9300
  232.       MultiLine       =   -1  'True
  233.       TabIndex        =   0
  234.       Top             =   1620
  235.       Visible         =   0   'False
  236.       Width           =   1185
  237.    End
  238.    Begin VB.ComboBox YdCombo 
  239.       Height          =   300
  240.       Left            =   9300
  241.       Style           =   2  'Dropdown List
  242.       TabIndex        =   3
  243.       Top             =   2010
  244.       Visible         =   0   'False
  245.       Width           =   1665
  246.    End
  247.    Begin VB.Timer Timer1 
  248.       Interval        =   1
  249.       Left            =   10530
  250.       Top             =   1560
  251.    End
  252.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  253.       Height          =   5835
  254.       Left            =   60
  255.       TabIndex        =   4
  256.       Top             =   1500
  257.       Width           =   8205
  258.       _cx             =   5080
  259.       _cy             =   5080
  260.       Appearance      =   1
  261.       BorderStyle     =   1
  262.       Enabled         =   -1  'True
  263.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  264.          Name            =   "宋体"
  265.          Size            =   9
  266.          Charset         =   134
  267.          Weight          =   400
  268.          Underline       =   0   'False
  269.          Italic          =   0   'False
  270.          Strikethrough   =   0   'False
  271.       EndProperty
  272.       MousePointer    =   0
  273.       BackColor       =   16777215
  274.       ForeColor       =   -2147483640
  275.       BackColorFixed  =   12632256
  276.       ForeColorFixed  =   -2147483630
  277.       BackColorSel    =   -2147483635
  278.       ForeColorSel    =   -2147483634
  279.       BackColorBkg    =   -2147483636
  280.       BackColorAlternate=   16777215
  281.       GridColor       =   -2147483633
  282.       GridColorFixed  =   -2147483632
  283.       TreeColor       =   -2147483632
  284.       FloodColor      =   192
  285.       SheetBorder     =   -2147483642
  286.       FocusRect       =   1
  287.       HighLight       =   1
  288.       AllowSelection  =   -1  'True
  289.       AllowBigSelection=   -1  'True
  290.       AllowUserResizing=   0
  291.       SelectionMode   =   0
  292.       GridLines       =   1
  293.       GridLinesFixed  =   2
  294.       GridLineWidth   =   1
  295.       Rows            =   50
  296.       Cols            =   10
  297.       FixedRows       =   1
  298.       FixedCols       =   1
  299.       RowHeightMin    =   0
  300.       RowHeightMax    =   0
  301.       ColWidthMin     =   0
  302.       ColWidthMax     =   0
  303.       ExtendLastCol   =   0   'False
  304.       FormatString    =   ""
  305.       ScrollTrack     =   0   'False
  306.       ScrollBars      =   3
  307.       ScrollTips      =   0   'False
  308.       MergeCells      =   0
  309.       MergeCompare    =   0
  310.       AutoResize      =   -1  'True
  311.       AutoSizeMode    =   0
  312.       AutoSearch      =   0
  313.       AutoSearchDelay =   2
  314.       MultiTotals     =   -1  'True
  315.       SubtotalPosition=   1
  316.       OutlineBar      =   0
  317.       OutlineCol      =   0
  318.       Ellipsis        =   0
  319.       ExplorerBar     =   0
  320.       PicturesOver    =   0   'False
  321.       FillStyle       =   0
  322.       RightToLeft     =   0   'False
  323.       PictureType     =   0
  324.       TabBehavior     =   0
  325.       OwnerDraw       =   0
  326.       Editable        =   0
  327.       ShowComboButton =   1
  328.       WordWrap        =   0   'False
  329.       TextStyle       =   0
  330.       TextStyleFixed  =   0
  331.       OleDragMode     =   0
  332.       OleDropMode     =   0
  333.       DataMode        =   0
  334.       VirtualData     =   -1  'True
  335.       DataMember      =   ""
  336.       ComboSearch     =   3
  337.       AutoSizeMouse   =   -1  'True
  338.       FrozenRows      =   0
  339.       FrozenCols      =   0
  340.       AllowUserFreezing=   0
  341.       BackColorFrozen =   0
  342.       ForeColorFrozen =   0
  343.       WallPaperAlignment=   9
  344.       AccessibleName  =   ""
  345.       AccessibleDescription=   ""
  346.       AccessibleValue =   ""
  347.       AccessibleRole  =   24
  348.    End
  349.    Begin MSComctlLib.Toolbar Tlb_Action 
  350.       Align           =   1  'Align Top
  351.       Height          =   555
  352.       Left            =   0
  353.       TabIndex        =   2
  354.       Top             =   0
  355.       Width           =   11400
  356.       _ExtentX        =   20108
  357.       _ExtentY        =   979
  358.       ButtonWidth     =   820
  359.       ButtonHeight    =   926
  360.       AllowCustomize  =   0   'False
  361.       Wrappable       =   0   'False
  362.       Appearance      =   1
  363.       Style           =   1
  364.       ImageList       =   "ImageList1"
  365.       _Version        =   393216
  366.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  367.          NumButtons      =   8
  368.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  369.             Caption         =   "设置"
  370.             Key             =   "ymsz"
  371.             Object.ToolTipText     =   "打印页面设置"
  372.             ImageKey        =   "sz"
  373.          EndProperty
  374.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  375.             Caption         =   "打印"
  376.             Key             =   "dy"
  377.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  378.             ImageKey        =   "dy"
  379.          EndProperty
  380.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  381.             Caption         =   "预览"
  382.             Key             =   "yl"
  383.             ImageKey        =   "yl"
  384.          EndProperty
  385.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  386.             Style           =   3
  387.          EndProperty
  388.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  389.             Caption         =   "删行"
  390.             Key             =   "sh"
  391.             Object.ToolTipText     =   "删除当前记录行或Delete"
  392.             ImageKey        =   "sh"
  393.          EndProperty
  394.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  395.             Style           =   3
  396.          EndProperty
  397.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  398.             Caption         =   "帮助"
  399.             Key             =   "bz"
  400.             ImageKey        =   "bz"
  401.          EndProperty
  402.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  403.             Caption         =   "退出"
  404.             Key             =   "fh"
  405.             ImageKey        =   "tc"
  406.          EndProperty
  407.       EndProperty
  408.       BorderStyle     =   1
  409.       Begin MSComctlLib.Toolbar GsToolbar 
  410.          Height          =   525
  411.          Left            =   9720
  412.          TabIndex        =   6
  413.          Top             =   0
  414.          Width           =   1695
  415.          _ExtentX        =   2990
  416.          _ExtentY        =   926
  417.          ButtonWidth     =   1455
  418.          ButtonHeight    =   926
  419.          AllowCustomize  =   0   'False
  420.          Appearance      =   1
  421.          Style           =   1
  422.          ImageList       =   "ImageList1"
  423.          _Version        =   393216
  424.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  425.             NumButtons      =   2
  426.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  427.                Caption         =   "保存格式"
  428.                Key             =   "bcgs"
  429.                ImageKey        =   "bcgs"
  430.             EndProperty
  431.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  432.                Caption         =   "默认列宽"
  433.                Key             =   "hfmrgs"
  434.                ImageKey        =   "mrlk"
  435.             EndProperty
  436.          EndProperty
  437.       End
  438.    End
  439.    Begin VB.Label Lab_OperStatus 
  440.       BackColor       =   &H000080FF&
  441.       Caption         =   "1"
  442.       Height          =   345
  443.       Left            =   10980
  444.       TabIndex        =   5
  445.       Top             =   1590
  446.       Visible         =   0   'False
  447.       Width           =   345
  448.    End
  449. End
  450. Attribute VB_Name = "Xs_P_PersonPlan"
  451. Attribute VB_GlobalNameSpace = False
  452. Attribute VB_Creatable = False
  453. Attribute VB_PredeclaredId = True
  454. Attribute VB_Exposed = False
  455. '**************************************************************************************************
  456. '*    模 块 名 称 :销售员销售编制计划
  457. '*    功 能 描 述 :
  458. '*    程序员姓名  :李建伟
  459. '*    最后修改人  :李建伟
  460. '*    最后修改时间:2001/10/16
  461. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起,注意此种录入需要修改"Sub Scdqfl"
  462. '*
  463. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  464. '*
  465. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  466. '**************************************************************************************************
  467.  
  468.  '以下为自定义变量
  469.  
  470.  
  471. '其它固定使用变量
  472. Dim Tsxx As String                              '系统信息提示(Fixed)
  473. Dim ReportTitle As String                       '报表主标题(Fixed)
  474.     
  475. '以下为固定使用变量(网格)
  476. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  477. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  478. Dim GridCode As String                          '显示网格网格代码
  479. Dim GridInf() As Variant                        '整个网格设置信息
  480. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  481. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  482. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  483. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  484. Dim Sjhgd As Double                             '网格数据行高度
  485. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  486. Dim GridStr()  As String                        '网格列信息(字符型)
  487. Dim GridInt() As Integer                        '网格列信息(整型)
  488. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  489. Dim Dqlrwgh As Long                             '当前录入数据网格行
  490. Dim Dqlrwgl As Long                             '当前录入数据网格列
  491. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  492. Dim Dqlkwgl As Long                             '刚刚离开网格列
  493. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  494. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  495. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  496. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  497. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  498. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  499. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  500. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  501. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  502. Dim Shsfts As Boolean                           '删除记录行是否提示
  503. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  504.     
  505. Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
  507.     Select Case KeyAscii
  508.         Case 39           '屏蔽字符"'"
  509.             KeyAscii = 0
  510.     End Select
  511.     
  512. End Sub
  514. Private Sub Form_Load()                              '窗 体 装 入
  515.   
  516.     '初始化各种锁值(Fixed)
  517.     Changelock = False             '网格行列改变控制锁
  518.     Gdtlock = False                '滚动条滚动控制
  519.     Yxxpdlock = True               '字段有效性判断锁
  520.     Hyxxpdlock = True              '行有效性判断锁
  521.     Wbkbhlock = False              '文本框内容改变锁
  522.    
  523.     '报表主标题及报表编码(Fixed)
  524.     ReportTitle = "销售员销售编制计划"
  525.     XtReportCode = "Xs_P_PersonPlan"
  526.     Load Dyymctbl
  528.     '调 入 网 格(Fixed)
  529.     GridCode = "Xs_P_PersonPlan"      '网格属性编码
  530.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  531.     
  532.     Qslz = GridInf(1)
  533.     Sjhgd = GridInf(2)
  534.     Pmbcsjhs = GridInf(3)
  535.     Fzxwghs = GridInf(4)
  536.     Sfblbzkd = GridInf(5)
  537.     Shsfts = GridInf(6)
  538.     Sfxshjwg = GridInf(7)
  539.     Szzls = WglrGrid.Cols - 1
  540.     
  541.     '设置标题栏宽度、网格宽度高度(Fixed)
  542.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  543.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  544.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  545.       
  546.     '生成查询结果
  547.     Call Sub_Query
  548.     Label1(1).Caption = GTempDeptName
  549.     Label1(3).Caption = GTempYear
  550.     '设置状态为修改状态
  551.     Lab_OperStatus = "2"
  552. End Sub
  554. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  555.     If Not Fun_Drfrmyxxpd Then
  556.        Cancel = True
  557.     End If
  558.     '卸载打印页面窗体
  559.     Unload Dyymctbl
  560.    
  561. End Sub
  563. Private Sub Sub_Query()                              '生成查询结果
  564.    
  565.     Dim Sqlstr As String                           '临时使用字符串
  566.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  567.     Dim Jsqte As Long                              '临时计数器
  568.     Dim TempPersonCode As String
  569.     Dim TempWareCode As String
  570.     Dim Coljsq As Long
  572.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  573.     WglrGrid.Redraw = False
  575.     '查询已有的计划
  576.     If GTempDeptCode = "" Then
  577.         Sqlstr = "SELECT Xs_Plan.*,MName,Model,SaleUnitName,PersonName,DeptName" & _
  578.             " From Xs_Plan, Gy_Person, Gy_Department, Gy_Material Where Xs_Plan.PersonCode = Gy_Person.PersonCode And " & _
  579.             " Xs_Plan.DeptCode = Gy_Department.DeptCode And Xs_Plan.WareCode= Gy_Material.Mnumber And CusCode='' " & _
  580.             " and KjYear=" & GTempYear & " Order By Xs_Plan.PersonCode,Xs_Plan.WareCode,period"
  581.     Else
  582.         Sqlstr = "SELECT Xs_Plan.*,MName,Model,SaleUnitName,PersonName,DeptName" & _
  583.             " From Xs_Plan, Gy_Person, Gy_Department, Gy_Material Where Xs_Plan.PersonCode = Gy_Person.PersonCode And " & _
  584.             " Xs_Plan.DeptCode = Gy_Department.DeptCode And Xs_Plan.WareCode= Gy_Material.Mnumber And CusCode='' " & _
  585.             " and KjYear=" & GTempYear & "and Xs_Plan.Deptcode='" & GTempDeptCode & "' Order By Xs_Plan.PersonCode,Xs_Plan.WareCode,period"
  586.     End If
  588.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  589.       
  590.     With RecTemp
  591.         WglrGrid.Rows = WglrGrid.FixedRows
  592.         Jsqte = WglrGrid.FixedRows - 1
  593.         
  594.         Do While Not .EOF
  595.             If TempPersonCode <> Trim(.Fields("Personcode") & "") Or TempWareCode <> Trim(.Fields("warecode")) Then
  596.                 Jsqte = Jsqte + 1
  597.                 WglrGrid.AddItem ""
  598.                 WglrGrid.TextMatrix(Jsqte, Sydz("000", GridStr(), Szzls)) = "*"
  599.                 TempPersonCode = Trim(.Fields("PersonCode") & "")
  600.                 TempWareCode = Trim(.Fields("Warecode") & "")
  601.                 WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("PersonCode") & "")                    '人员编码
  602.                 WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "")                    '人员名称
  603.                 WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("WareCode") & "")                      '货物编码
  604.                 WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("MName") & "")                         '货物名称
  605.                 WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                         '存货规格
  606.                 WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("SaleUnitName") & "")                  '销售单位
  607.                 WglrGrid.TextMatrix(Jsqte, Sydz("033", GridStr(), Szzls)) = Trim(.Fields("DeptCode") & "")                      '部门编码
  608.                 WglrGrid.TextMatrix(Jsqte, Sydz("034", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")                      '部门编码
  609.                 WglrGrid.TextMatrix(Jsqte, Sydz("035", GridStr(), Szzls)) = Trim(.Fields("PlanID") & "")                        '部门编码
  610.             End If
  611.                     Select Case .Fields("Period")
  612.                         Case 0
  613.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  614.                                 WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '年计划数量
  615.                             End If
  616.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  617.                                 WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("PlanMoney")                                '年计划金额
  618.                             End If
  619.                         Case 1
  620.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  621.                                 WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '一月份计划数量
  622.                             End If
  623.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  624.                                 WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = .Fields("PlanMoney")                                '一月份计划金额
  625.                             End If
  626.                         Case 2
  627.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  628.                                 WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '二月份计划数量
  629.                             End If
  630.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  631.                                 WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = .Fields("PlanMoney")                                '二月份计划金额
  632.                             End If
  633.                         Case 3
  634.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  635.                                 WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '三月份计划数量
  636.                             End If
  637.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  638.                                 WglrGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = .Fields("PlanMoney")                                '三月份计划金额
  639.                             End If
  640.                         Case 4
  641.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  642.                                 WglrGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '四月份计划数量
  643.                             End If
  644.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  645.                                 WglrGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = .Fields("PlanMoney")                                '四月份计划金额
  646.                             End If
  647.                         Case 5
  648.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  649.                                 WglrGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '五月份计划数量
  650.                             End If
  651.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  652.                                 WglrGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = .Fields("PlanMoney")                                '五月份计划金额
  653.                             End If
  654.                         Case 6
  655.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  656.                                 WglrGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '六月份计划数量
  657.                             End If
  658.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  659.                                 WglrGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = .Fields("PlanMoney")                                '六月份计划金额
  660.                             End If
  661.                         Case 7
  662.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  663.                                 WglrGrid.TextMatrix(Jsqte, Sydz("021", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '七月份计划数量
  664.                             End If
  665.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  666.                                 WglrGrid.TextMatrix(Jsqte, Sydz("022", GridStr(), Szzls)) = .Fields("PlanMoney")                                '七计划金额
  667.                             End If
  668.                         Case 8
  669.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  670.                                 WglrGrid.TextMatrix(Jsqte, Sydz("023", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '八月份计划数量
  671.                             End If
  672.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  673.                                 WglrGrid.TextMatrix(Jsqte, Sydz("024", GridStr(), Szzls)) = .Fields("PlanMoney")                                '八月份计划金额
  674.                             End If
  675.                         Case 9
  676.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  677.                                 WglrGrid.TextMatrix(Jsqte, Sydz("025", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '九月份计划数量
  678.                             End If
  679.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  680.                                 WglrGrid.TextMatrix(Jsqte, Sydz("026", GridStr(), Szzls)) = .Fields("PlanMoney")                                '九月份计划金额
  681.                             End If
  682.                         Case 10
  683.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  684.                                 WglrGrid.TextMatrix(Jsqte, Sydz("027", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十月份计划数量
  685.                             End If
  686.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  687.                                 WglrGrid.TextMatrix(Jsqte, Sydz("028", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十月份计划金额
  688.                             End If
  689.                         Case 11
  690.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  691.                                 WglrGrid.TextMatrix(Jsqte, Sydz("029", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十一月份计划数量
  692.                             End If
  693.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  694.                                 WglrGrid.TextMatrix(Jsqte, Sydz("030", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十一月份计划金额
  695.                             End If
  696.                         Case 12
  697.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  698.                                 WglrGrid.TextMatrix(Jsqte, Sydz("031", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十二月份计划数量
  699.                             End If
  700.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  701.                                 WglrGrid.TextMatrix(Jsqte, Sydz("032", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十二月份计划金额
  702.                             End If
  703.                     End Select
  704.             '<<]
  705.            
  706.             WglrGrid.RowHeight(Jsqte) = Sjhgd
  707.             .MoveNext
  708.         Loop
  709.     End With
  710.     '将网格刷新解禁(Fixed)
  711.     WglrGrid.Redraw = True
  713.     '调整网格(Fixed)
  714.     Call Sub_AdjustGrid
  715.     '在辅助行上填写合计行
  716.     WglrGrid.TextMatrix(WglrGrid.Rows - 1, 1) = "合计"
  717.     '进行列合计
  718.     For Coljsq = Qslz To WglrGrid.Cols - 1
  719.         Call Sjhj(Coljsq)
  720.     Next Coljsq
  721. End Sub
  723. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  724.      
  725.     '屏蔽文本框,下拉组合框有效性判断
  726.      
  727.     Valilock = True
  728.      
  729.     '屏蔽网格失去焦点产生的有效性判断
  730.      
  731.     Changelock = True
  732.      
  733.     Select Case Button.Key
  734.         Case "ymsz"                                          '页面设置
  735.             Dyymctbl.Show 1
  736.         Case "yl"                                            '预 览
  737.             If Fun_Drfrmyxxpd Then
  738.                 Call bbyl(True)
  739.             End If
  740.         Case "dy"                                            '打 印
  741.             If Fun_Drfrmyxxpd Then
  742.                 Call bbyl(False)
  743.             End If
  744.         Case "sh"                                            '删 行
  745.             Call Scdqfl
  746.         Case "bz"                                            '帮 助
  747.             Call F1bz
  748.         Case "fh"                                            '退 出
  749.                 Unload Me
  750.     End Select
  751.        
  752.     '解 锁
  753.     Valilock = False
  754.     Changelock = False
  755.         
  756. End Sub
  758. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  760.     If Shift = 2 Then
  761.         Select Case UCase(Chr(KeyCode))
  762.             Case "P"                   'Ctrl+P 打印
  763.                 If Tlb_Action.Buttons("dy").Enabled Then
  764.                     Call bbyl(False)
  765.                 End If
  766.             End Select
  767.     End If
  768.     
  769. End Sub
  771. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  772.     
  773.     Dim xswbrr As String
  774.     
  775.     With WglrGrid
  776.         Zdlrqnr = Trim(.Text)
  777.         xswbrr = Trim(.Text)
  778.     
  779.         If GridBoolean(.Col, 3) Then   '列表框录入
  780.     
  781.             '填充列表框程序
  782.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  783.         Else
  784.             Wbkbhlock = True
  785.        
  786.             '====以下为用户自定义
  787.             Ydtext.Text = xswbrr
  788.             '====以上为用户自定义
  789.          
  790.             Wbkbhlock = False
  791.             Ydtext.SelStart = Len(Ydtext.Text)
  792.         End If
  793.     End With
  794.     
  795. End Sub
  797. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  798.  '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  800.     Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
  801.     Dim Coljsq As Long                          '临时列计数器(Fixed)
  802.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
  803.     Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
  805.     With WglrGrid
  806.     
  807.         '非录入状态或非数据行则其有效性为合法(Fixed)
  808.         If Yxxpdlock Or .Row < .FixedRows Then
  809.             sjzdyxxpd = True
  810.             Exit Function
  811.         End If
  812.       
  813.         '取得当前要判断字段内容(Fixed)
  814.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  815.       
  816.         '根据不同字段进行相应的处理(依据其逻辑编号)
  817.         Select Case GridStr(Dqpdwgl, 1)
  818.          
  819.             '[>>以下为自定义部分
  820.          
  821.             Case "001"                   '人员编码(字段不为空则做有效性判断及事后处理)
  822.                 If Not Trim(Str_JudgeText) = "" Then
  823.                     '1.放置字段有效性判断
  824.                     If GTempDeptCode = "" Then
  825.                         Sqlstr = "SELECT Gy_Person.DeptCode,deptName,PersonCode,PersonName From Gy_Person,Gy_Department Where Gy_Department.XsFlag='1' and Gy_Person.DeptCode=Gy_Department.DeptCode and (PersonCode='" & Str_JudgeText & "' Or PersonName='" & Str_JudgeText & "')"
  826.                     Else
  827.                         Sqlstr = "SELECT Gy_Person.DeptCode,deptName,PersonCode,PersonName From Gy_Person,Gy_Department Where Gy_Department.Deptcode='" & GTempDeptCode & "' and Gy_Person.DeptCode=Gy_Department.DeptCode and (PersonCode='" & Str_JudgeText & "' Or PersonName='" & Str_JudgeText & "')"
  828.                     End If
  829.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  830.                   
  831.                     If RecTemp.EOF Then
  832.                         Tsxx = "此人员编码不存在!"
  833.                         GoTo Lrcwcl
  834.                     End If
  835.                     
  836.                     '2.放置字段事后处理程序
  837.                     .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("PersonCode") & "")      '显示人员编码
  838.                     .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("PersonName") & "")      '显示人员名称
  839.                     .TextMatrix(Dqpdwgh, Sydz("033", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptCode") & "")      '显示部门编码
  840.                     .TextMatrix(Dqpdwgh, Sydz("034", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptName") & "")      '显示部门编码
  841.                 Else
  842.                     '3.清空相关字段
  843.                     .TextMatrix(Dqpdwgh, Sydz("000", GridStr(), Szzls)) = ""
  844.                     .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""
  845.                     .TextMatrix(Dqpdwgh, Sydz("033", GridStr(), Szzls)) = ""
  846.                     .TextMatrix(Dqpdwgh, Sydz("034", GridStr(), Szzls)) = ""
  847.                 End If
  848.             Case "003"                   '存货编码(字段不为空则做有效性判断及事后处理)
  849.                 If Not Trim(Str_JudgeText) = "" Then
  850.                     '1.放置字段有效性判断
  851.                     If .TextMatrix(Dqpdwgh, Sydz("035", GridStr(), Szzls)) <> "" Then
  852.                         Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Material Where Planid<> " & .TextMatrix(Dqpdwgh, Sydz("035", GridStr(), Szzls)) & " and Period=0 and KjYear=" & Xtyear & " and issale=1 and StopFlag=0 and Xs_Plan.Warecode=Gy_Material.Mnumber and PersonCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & "'  and (Warecode='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "')"
  853.                     Else
  854.                         Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Material Where Period=0 and KjYear=" & Xtyear & " and issale=1 and StopFlag=0 and Xs_Plan.Warecode=Gy_Material.Mnumber and PersonCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & "'  and (Warecode='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "')"
  855.                     End If
  856.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  857.                   
  858.                     If Not RecTemp.EOF Then
  859.                         Tsxx = "此销售员已经有该货物的销售计划!"
  860.                         GoTo Lrcwcl
  861.                     End If
  862.                 End If
  863.                 If Not Trim(Str_JudgeText) = "" Then
  864.                     '1.放置字段有效性判断
  865.                     Sqlstr = "SELECT MNumber,MName,Model,SaleUnitName From Gy_material Where (MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "') And IsSale='1'"
  866.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  867.                   
  868.                     If RecTemp.EOF Then
  869.                         Tsxx = "此货物编码不存在!"
  870.                         GoTo Lrcwcl
  871.                     End If
  872.                     
  873.                     '2.放置字段事后处理程序
  874.                     .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "")      '显示存货编码
  875.                     .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")      '显示存货编码
  876.                     .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")      '显示存货名称
  877.                     .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Trim(RecTemp.Fields("SaleUnitName") & "")      '显示存货名称
  878.                 Else
  879.                 
  880.                     '3.清空相关字段
  881.                     .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""                                             '显示存货名称
  882.                     .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = ""                                             '显示存货名称
  883.                     .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = ""                                             '显示存货名称
  884.                 End If
  885.                 
  886.             '<<以上为自定义部分]
  887.         End Select
  888.      
  889.         '字段录入正确后为零字段清空(Fixed)
  890.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  891.         For Coljsq = Qslz To .Cols - 1
  892.             Call Sjhj(Coljsq)
  893.         Next Coljsq
  894.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  895.         sjzdyxxpd = True
  896.         Yxxpdlock = True
  897.         Exit Function
  898.     End With
  899.   
  900. Lrcwcl:    '录入错误处理(Fixed)
  902.     With WglrGrid
  903.         '给出错误提示信息
  904.         Call Xtxxts(Tsxx, 0, 1)
  905.       
  906.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  907.         Changelock = True
  908.         .Select Dqpdwgh, Dqpdwgl
  909.         Changelock = False
  910.         Call xswbk
  911.       
  912.         '函数返回False
  913.         sjzdyxxpd = False
  914.         Exit Function
  915.     End With
  916.     
  917. End Function
  918. Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
  919.     
  920.     Dim Hjjg As Double
  921.     If Not GridBoolean(Hjwgl, 4) Then
  922.         Exit Sub
  923.     End If
  924.     With WglrGrid
  925.         Hjjg = 0
  926.         For Jsqte = .FixedRows To .Rows - 2
  927.                 If Trim(.TextMatrix(Jsqte, Hjwgl)) <> "" Then
  928.                     Hjjg = Hjjg + Val(.TextMatrix(Jsqte, Hjwgl))
  929.                 End If
  930.         Next Jsqte
  931.         If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
  932.             WglrGrid.TextMatrix(.Rows - 1, Hjwgl) = ""
  933.         Else
  934.             WglrGrid.TextMatrix(.Rows - 1, Hjwgl) = Hjjg
  935.         End If
  936.     End With
  938. End Sub
  940. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  941.  
  942.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  943.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  944.     Dim Sqlstr As String                   '临时查询字符串
  945.     Dim SumPlanAmount As Single
  946.     Dim SumPlanMoney As Single
  947.     With WglrGrid
  948.         If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
  949.         '判断行为空和无效数据行则清除当前行
  950.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  951.             Sjhzyxxpd = True
  952.             Exit Function
  953.         Else
  954.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  955.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  956.                     Changelock = True
  957.                     .RemoveItem Yxxpdh
  958.                     
  959.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  960.                         .AddItem ""
  961.                         .RowHeight(.Rows - 1) = Sjhgd
  962.                     End If
  963.                     
  964.                     Changelock = False
  965.                     Sjhzyxxpd = True
  966.                     Exit Function
  967.                 End If
  968.             End If
  969.         End If
  970.   
  971.         '行没有发生变化则不进行有效性判断
  972.         If Hyxxpdlock Then
  973.             Sjhzyxxpd = True
  974.             Exit Function
  975.         End If
  977.         '以下为自定义部分[
  979.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  980.         For Jsqte = Qslz To .Cols - 1
  981.                
  982.             '字段不能为空
  983.             If GridInt(Jsqte, 5) = 1 Then
  984.                 If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  985.                     Tsxx = GridStr(Jsqte, 2)
  986.                     Lrywlz = Jsqte
  987.                     GoTo Lrcwcl
  988.                     Exit For
  989.                 End If
  990.             End If
  991.                
  992.             '字段不能为零
  993.             If GridInt(Jsqte, 5) = 2 Then
  994.                 If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  995.                     Tsxx = GridStr(Jsqte, 2)
  996.                     Lrywlz = Jsqte
  997.                     GoTo Lrcwcl
  998.                     Exit For
  999.                 End If
  1000.             End If
  1001.                
  1002.             Next Jsqte
  1005.         '1.2进行其他有效性判断,编写格式同1.1
  1006.         '判断年计划数量是否等于各月计划数量之和
  1007.         '判断年计划金额是否等于各月计划金额之和
  1008.         For TempCol = 9 To 31 Step 2
  1009.             If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)) = "" Then
  1010.                 SumPlanAmount = SumPlanAmount + 0
  1011.             Else
  1012.                 SumPlanAmount = SumPlanAmount + Val(Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)))
  1013.             End If
  1014.             If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) = "" Then
  1015.                 SumPlanMoney = SumPlanMoney + 0
  1016.             Else
  1017.                 SumPlanMoney = SumPlanMoney + Val(Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)))
  1018.             End If
  1019.         Next
  1020.         If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 7))) <> SumPlanAmount Then
  1021.                     Tsxx = "年计划数量不等于各月计划数量总和!"
  1022.                     Lrywlz = 7
  1023.                     GoTo Lrcwcl
  1024.         End If
  1025.         If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 8))) <> SumPlanMoney Then
  1026.                     Tsxx = "年计划金额不等于各月计划金额总和!"
  1027.                     Lrywlz = 8
  1028.                     GoTo Lrcwcl
  1029.         End If
  1030.         '判断年计划数量和年计划金额是否同时为零
  1031.         If Val(WglrGrid.TextMatrix(Yxxpdh, 7)) = 0 And Val(WglrGrid.TextMatrix(Yxxpdh, 8)) = 0 Then
  1032.             Sjhzyxxpd = True
  1033.             Exit Function
  1034.         End If
  1035.             
  1036.         '2.放置行处理程序(当数据行通过有效性判断)
  1037.        
  1038.         On Error GoTo Swcwcl
  1040.         Cw_DataEnvi.DataConnect.BeginTrans
  1041.         If WglrGrid.TextMatrix(Yxxpdh, 35) <> "" Then
  1042.             Cw_DataEnvi.DataConnect.Execute ("delete from xs_plan WHERE Planid>=" & Val(WglrGrid.TextMatrix(Yxxpdh, 35)) & " and Planid<=" & Val(WglrGrid.TextMatrix(Yxxpdh, 35)) + 12)
  1043.         End If
  1044.         With RecTemp
  1045.             If .State = 1 Then .Close
  1046.             .Open "SELECT * FROM Xs_Plan WHERE WareCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) & "' and PersonCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 1)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1047.                 MonthValue = 0
  1048.                 For TempCol = 7 To 31 Step 2
  1049.                     .AddNew
  1050.                     .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 33))
  1051.                     .Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 1))
  1052.                     .Fields("WareCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 3))
  1053.                     .Fields("KjYear") = Xtyear
  1054.                     .Fields("Period") = MonthValue
  1055.                     If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)) = "" Then
  1056.                         .Fields("PlanAmount") = 0
  1057.                     Else
  1058.                         .Fields("PlanAmount") = Val(WglrGrid.TextMatrix(Yxxpdh, TempCol))  '金额
  1059.                     End If
  1060.                     If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) = "" Then
  1061.                         .Fields("PlanMoney") = 0
  1062.                     Else
  1063.                         .Fields("PlanMoney") = Val(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) '金额                .Update
  1064.                     End If
  1065.                     MonthValue = MonthValue + 1
  1066.                     RecTemp.Update
  1067.                 Next
  1068.                 WglrGrid.TextMatrix(Yxxpdh, 35) = .Fields("PlanID") - 12
  1069.         End With
  1071.         Cw_DataEnvi.DataConnect.CommitTrans
  1072.          
  1073.     End With
  1075.     '以上为自定义部分]
  1077.     Sjhzyxxpd = True
  1078.     Hyxxpdlock = True
  1079.     Exit Function
  1081. Swcwcl:
  1083.     Cw_DataEnvi.DataConnect.RollbackTrans
  1084.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  1085.     Call Xtxxts(Tsxx, 0, 1)
  1086.     Exit Function
  1088. Lrcwcl:      '录入错误处理
  1090.     With WglrGrid
  1091.         Call Xtxxts(Tsxx, 0, 1)
  1092.         Changelock = True
  1093.         .Select Yxxpdh, Lrywlz
  1094.         Changelock = False
  1095.         Call xswbk
  1097.         Sjhzyxxpd = False
  1098.         Exit Function
  1099.     End With
  1100.     
  1101. End Function
  1103. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  1104. Private Sub Sub_AdjustGrid()
  1106.     '调 整 网 格
  1107.     With WglrGrid
  1108.         '加 1 保持一行录入行
  1109.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1110.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1111.             For Jsqte = .FixedRows To .Rows - 1
  1112.                 .RowHeight(Jsqte) = Sjhgd
  1113.             Next Jsqte
  1114.         End If
  1115.             '判断是否有辅助行和录入行,如没有则加行
  1116.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  1117.                 .AddItem ""
  1118.                 .RowHeight(.Rows - 1) = Sjhgd
  1119.             Loop
  1120. '        End If
  1121.     End With
  1122.   
  1123. End Sub
  1125. Private Sub Lrzdbz()                                                      '录入字段帮助
  1126.   
  1127.     If Not Ydcommand.Visible Then
  1128.         Exit Sub
  1129.     End If
  1130.    
  1131.     With WglrGrid
  1132.      
  1133.         Valilock = True
  1134.     
  1135.         '处理通用部分
  1136.         If GTempDeptCode = "" Then
  1137.             Cw_DataEnvi.DataConnect.Execute ("update Xt_tyhelp set sql_string='select PersonCode,Personname,Deptname from Gy_Person,Gy_Department where Gy_Person.DeptCode=Gy_Department.DeptCode and XsFlag=1 order by PersonCode ' WHERE help_code = 'xs_cz_personplan'")
  1138.         Else
  1139.             Cw_DataEnvi.DataConnect.Execute ("update Xt_tyhelp set sql_string='select PersonCode,Personname,Deptname from Gy_Person,Gy_Department where Gy_Person.DeptCode=Gy_Department.DeptCode and Gy_Department.DeptCode=" & GTempDeptCode & " order by PersonCode ' WHERE help_code = 'xs_cz_personplan'")
  1140.         End If
  1141.         Changelock = True        '调入另外窗体必须加锁
  1142.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  1143.         Changelock = False
  1144.         
  1145.         If Len(Xtfhcs) <> 0 Then
  1146.             If GridInt(.Col, 7) = 0 Then
  1147.                 Ydtext.Text = Xtfhcs
  1148.             Else
  1149.                 Ydtext.Text = Xtfhcsfz
  1150.             End If
  1151.         End If
  1152.             
  1153.         Valilock = False
  1154.         
  1155.         If Ydtext.Visible Then
  1156.             Ydtext.SetFocus
  1157.         End If
  1158.     
  1159.     End With
  1160.     
  1161. End Sub
  1163. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  1164.    
  1165.     Call Cxxswbk
  1166.     
  1167. End Sub
  1169. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1170.   
  1171.     Fun_Drfrmyxxpd = True
  1172.     
  1173.     With WglrGrid
  1174.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1175.         
  1176.         If Ydtext.Visible Or YdCombo.Visible Then
  1177.             Call Lrsjhx
  1178.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1179.                 Fun_Drfrmyxxpd = False
  1180.                 Exit Function
  1181.             End If
  1182.         End If
  1183.         
  1184.         '进行行有效性判断
  1185.         If Not Sjhzyxxpd(.Row) Then
  1186.             Fun_Drfrmyxxpd = False
  1187.             Exit Function
  1188.         End If
  1189.     End With
  1190.   
  1191. End Function
  1193. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  1194.    
  1195.     With WglrGrid
  1196.         If .Row >= .FixedRows Then
  1197.             '[>>
  1198.                 '此处可以填写显示与此网格行相关信息
  1199.             '<<]
  1200.         End If
  1201.    End With
  1202.    
  1203. End Sub
  1205. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1207.     '网格得到焦点,如果当前选择行为非数据行
  1208.     '则调整当前焦点至有效数据行
  1210.     With WglrGrid
  1211.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1212.             Changelock = True
  1213.             .Select .FixedRows, .Col
  1214.             Changelock = False
  1215.         End If
  1216.         If .Col < Qslz Then
  1217.             Changelock = True
  1218.             .Select .Row, Qslz
  1219.             Changelock = False
  1220.         End If
  1221.     End With
  1223. End Sub
  1225. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1227.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1228.     If Changelock Then
  1229.         Exit Sub
  1230.     End If
  1232.     '引发网格RowcolChange事件
  1233.     With WglrGrid
  1234.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1235.             .Select 0, 0
  1236.         End If
  1237.     End With
  1239. End Sub
  1241. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1243.     If Gdtlock Then
  1244.         Exit Sub
  1245.     End If
  1246.  
  1247.     With WglrGrid
  1248.         If Ydtext.Visible Or YdCombo.Visible Then
  1249.             Gdtlock = True
  1250.             .TopRow = Dqtoprow
  1251.             .LeftCol = Dqleftcol
  1252.             Gdtlock = False
  1253.             Exit Sub
  1254.         End If
  1255.     End With
  1256.     
  1257. End Sub
  1259. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1260.   
  1261.     If Changelock Then
  1262.         Exit Sub
  1263.     End If
  1265.     '记录刚刚离开网格单元的行列值
  1266.     Dqlkwgh = WglrGrid.Row
  1267.     Dqlkwgl = WglrGrid.Col
  1269.     '判断是否需要录入数据回写
  1270.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1271.         Exit Sub
  1272.     End If
  1273.     
  1274.     Call Lrsjhx
  1275.     
  1276. End Sub
  1278. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1279.    
  1280.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1281.     
  1282.     With WglrGrid
  1283.         If Changelock Then
  1284.             Exit Sub
  1285.         End If
  1286.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1287.             Exit Sub
  1288.         End If
  1289.         If .Row <> Dqlkwgh Then
  1290.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1291.                 Exit Sub
  1292.             End If
  1293.         End If
  1294.     End With
  1295.     
  1296.     Call fhyxh
  1297.     Call Xldql
  1298.    
  1299. End Sub
  1301. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1302.     If Xtyear <> GTempYear Then
  1303.         Exit Sub
  1304.     End If
  1305.     With WglrGrid
  1306.         Call xswbk
  1307.     End With
  1308.   
  1309. End Sub
  1311. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1312.  
  1313.     Valilock = True
  1314.     Ydtext.Visible = False
  1315.     YdCombo.Visible = False
  1316.     Ydcommand.Visible = False
  1317.     
  1318. End Sub
  1320. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1321.     With WglrGrid
  1322.         Select Case KeyCode
  1323.             Case vbKeyEscape                'ESC 键放弃录入
  1324.                 Valilock = True
  1325.                 .SetFocus
  1326.                 Call Ycwbk
  1327.                 Valilock = False
  1328.             Case vbKeyReturn                '回 车 键 =13
  1329.                 KeyCode = 0
  1330.                 .SetFocus
  1331.                 Call Lrsjhx
  1332.                 Rowjsq = .Row
  1333.                 Coljsq = .Col + 1
  1334.                 If Coljsq > .Cols - 1 Then
  1335.                     If Rowjsq < .Rows - 1 Then
  1336.                         Rowjsq = Rowjsq + 1
  1337.                     End If
  1338.                     Coljsq = Qslz
  1339.                 End If
  1340.                 Do While Rowjsq <= .Rows - 1
  1341.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1342.                         Coljsq = Coljsq + 1
  1343.                         If Coljsq > .Cols - 1 Then
  1344.                             Rowjsq = Rowjsq + 1
  1345.                             Coljsq = Qslz
  1346.                         End If
  1347.                     Else
  1348.                         Exit Do
  1349.                     End If
  1350.                 Loop
  1351.                 .Select Rowjsq, Coljsq
  1352.                 
  1353.             Case vbKeyLeft                  '左 箭 头 =37
  1354.                 If .Col - 1 = Qslz Then
  1355.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1356.                         GoTo jzzx
  1357.                     End If
  1358.                 End If
  1359.                 If .Col > Qslz Then
  1360.                     KeyCode = 0
  1361.                     .SetFocus
  1362.                     Call Lrsjhx
  1363.                     Coljsq = .Col - 1
  1364.                     Do While Coljsq > Qslz
  1365.                         If Coljsq - 1 = Qslz Then
  1366.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1367.                                 GoTo jzzx
  1368.                             End If
  1369.                         End If
  1370.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1371.                             Coljsq = Coljsq - 1
  1372.                         Else
  1373.                             Exit Do
  1374.                         End If
  1375.                     Loop
  1376.                     .Select .Row, Coljsq
  1377.                 End If
  1379.             Case vbKeyRight                 '右 箭 头 =39
  1380.                 KeyCode = 0
  1381.                 .SetFocus
  1382.                 Call Lrsjhx
  1383.                 Rowjsq = .Row
  1384.                 Coljsq = .Col + 1
  1385.                 If Coljsq > .Cols - 1 Then
  1386.                     If Rowjsq < .Rows - 1 Then
  1387.                         Rowjsq = Rowjsq + 1
  1388.                     End If
  1389.                     Coljsq = Qslz
  1390.                 End If
  1391.                 Do While Rowjsq <= .Rows - 1
  1392.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1393.                         Coljsq = Coljsq + 1
  1394.                         If Coljsq > .Cols - 1 Then
  1395.                             Rowjsq = Rowjsq + 1
  1396.                             Coljsq = Qslz
  1397.                         End If
  1398.                     Else
  1399.                         Exit Do
  1400.                     End If
  1401.                 Loop
  1402.                 .Select Rowjsq, Coljsq
  1403.             Case Else
  1404.             
  1405.         End Select
  1406.    
  1407. jzzx:
  1408.    
  1409.     End With
  1410.     
  1411. End Sub
  1413. Private Sub YdCombo_LostFocus()
  1414.   
  1415.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1416.         If Not Valilock Then                           '为TRUE
  1417.             Call Lrsjhx
  1418.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1419.                 Exit Sub
  1420.             End If
  1421.         End If
  1422.     End With
  1423. End Sub
  1425. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1426.    
  1427.     Call Lrzdbz
  1428.    
  1429. End Sub
  1431. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1432.    
  1433.     Dim Rowjsq As Long, Coljsq As Long
  1434.     
  1435.     With WglrGrid
  1436.         Select Case KeyCode
  1437.             Case vbKeyF2
  1438.                 Call Lrzdbz
  1439.             Case vbKeyEscape                'ESC 键放弃录入
  1440.                 Valilock = True
  1441.                 Call Ycwbk
  1442.                 .SetFocus
  1443.             Case vbKeyReturn                '回 车 键 =13
  1444.                 KeyCode = 0
  1445.                 .SetFocus
  1446.                 Call Lrsjhx
  1447.                 Rowjsq = .Row
  1448.                 Coljsq = .Col + 1
  1449.                 If Coljsq > .Cols - 1 Then
  1450.                     If Rowjsq < .Rows - 1 Then
  1451.                         Rowjsq = Rowjsq + 1
  1452.                     End If
  1453.                     Coljsq = Qslz
  1454.                 End If
  1455.                 Do While Rowjsq <= .Rows - 1
  1456.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1457.                         Coljsq = Coljsq + 1
  1458.                         If Coljsq > .Cols - 1 Then
  1459.                             Rowjsq = Rowjsq + 1
  1460.                             Coljsq = Qslz
  1461.                         End If
  1462.                     Else
  1463.                         Exit Do
  1464.                     End If
  1465.                 Loop
  1466.                 If Rowjsq <= .Rows - 1 Then
  1467.                     .Select Rowjsq, Coljsq
  1468.                 End If
  1469.                 
  1470.             Case vbKeyUp                    '上 箭 头 =38
  1471.                 KeyCode = 0
  1472.                 .SetFocus
  1473.                 Call Lrsjhx
  1474.                 If .Row > .FixedRows Then
  1475.                     .Row = .Row - 1
  1476.                 End If
  1477.                 
  1478.             Case vbKeyDown                  '下 箭 头 =40
  1479.                 KeyCode = 0
  1480.                 .SetFocus
  1481.                 Call Lrsjhx
  1482.                 If .Row < .Rows - 1 Then
  1483.                     .Row = .Row + 1
  1484.                 End If
  1485.                 
  1486.             Case vbKeyLeft                  '左 箭 头 =37
  1487.                 If .Col - 1 = Qslz Then
  1488.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1489.                         GoTo jzzx
  1490.                     End If
  1491.                 End If
  1492.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  1493.                     KeyCode = 0
  1494.                     .SetFocus
  1495.                     Call Lrsjhx
  1496.                     Coljsq = .Col - 1
  1497.                     Do While Coljsq > Qslz
  1498.                         If Coljsq - 1 = Qslz Then
  1499.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1500.                                 GoTo jzzx
  1501.                             End If
  1502.                         End If
  1503.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1504.                             Coljsq = Coljsq - 1
  1505.                         Else
  1506.                             Exit Do
  1507.                         End If
  1508.                     Loop
  1509.                     .Select .Row, Coljsq
  1510.                 End If
  1511. jzzx:
  1512.            
  1513.             Case vbKeyRight                 '右 箭 头 =39
  1514.                 wblong = Len(Ydtext.Text)
  1515.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1516.                     KeyCode = 0
  1517.                     .SetFocus
  1518.                     Call Lrsjhx
  1519.                     Rowjsq = .Row
  1520.                     Coljsq = .Col + 1
  1521.                     If Coljsq > .Cols - 1 Then
  1522.                         If Rowjsq < .Rows - 1 Then
  1523.                             Rowjsq = Rowjsq + 1
  1524.                         End If
  1525.                         Coljsq = Qslz
  1526.                     End If
  1527.                     Do While Rowjsq <= .Rows - 1
  1528.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1529.                             Coljsq = Coljsq + 1
  1530.                             If Coljsq > .Cols - 1 Then
  1531.                                 Rowjsq = Rowjsq + 1
  1532.                                 Coljsq = Qslz
  1533.                             End If
  1534.                         Else
  1535.                             Exit Do
  1536.                         End If
  1537.                     Loop
  1538.                     .Select Rowjsq, Coljsq
  1539.                 End If
  1540.             Case Else
  1541.             
  1542.         End Select
  1543.     End With
  1544.     
  1545. End Sub
  1547. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1549.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1550.     
  1551.     If KeyAscii <> 0 Then
  1552.         Call Xyxhbz(Dqlrwgh)
  1553.     End If
  1554.     
  1555. End Sub
  1557. Private Sub ydtext_Change()                              '录入事中变化处理
  1559.     '防止程序改变但不进行处理
  1561.     If Wbkbhlock Then
  1562.         Exit Sub
  1563.     End If
  1565.     With WglrGrid
  1567.         '限制字段录入长度
  1568.          Wbkbhlock = True
  1569.         Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  1570.         Select Case GridInt(.Col, 1)
  1571.             Case 8, 11   '金额型
  1572.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1573.             Case 9, 12   '数量型
  1574.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1575.             Case 10      '单价型
  1576.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1577.             Case Else    '其他类型
  1578.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1579.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1580.                 End If
  1581.         End Select
  1582.         Wbkbhlock = False
  1583.     End With
  1584.     
  1585. End Sub
  1587. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1588.   
  1589.     With WglrGrid
  1590.         If Not Valilock Then
  1591.             Call Lrsjhx
  1592.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1593.                 Exit Sub
  1594.             End If
  1595.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1596.                 Exit Sub
  1597.             End If
  1598.         End If
  1599.     End With
  1600.   
  1601. End Sub
  1603. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1604.     
  1605.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1606.   
  1607.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1608.     If Not Fun_AllowInput Then
  1609.         Exit Sub
  1610.     End If
  1611.   
  1612.     '显示文本框前返回有效行列（解决滚动条问题）
  1613.     Call Xldqh
  1614.     Call Xldql
  1615.   
  1616.     '隐藏文本框,帮助按钮,列表组合框
  1617.     Call Ycwbk
  1618.   
  1619.     With WglrGrid
  1620.         Dqlrwgh = .Row
  1621.         Dqlrwgl = .Col
  1622.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1623.             Exit Sub
  1624.         End If
  1625.      
  1626.         Wbkpy = 30
  1627.         Wbkpy1 = 15
  1628.         On Error Resume Next
  1629.     
  1630.         If GridBoolean(.Col, 3) Then
  1631.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1632.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1633.             YdCombo.Width = .CellWidth - Wbkpy1
  1634.             Call Wbkcl
  1635.             YdCombo.Visible = True
  1636.             YdCombo.SetFocus
  1637.             Ydcommand.Visible = False
  1638.             Ydtext.Visible = False
  1639.         Else
  1640.             If GridBoolean(.Col, 2) Then
  1641.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1642.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1643.                 Ydcommand.Visible = True
  1644.             Else
  1645.                 Ydcommand.Visible = False
  1646.             End If
  1647.      
  1648.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1649.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1650.             
  1651.             If Ydcommand.Visible Then
  1652.                 If Sfblbzkd Then
  1653.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1654.                 Else
  1655.                     Ydtext.Width = .CellWidth - Wbkpy1
  1656.                 End If
  1657.             Else
  1658.                 Ydtext.Width = .CellWidth - Wbkpy1
  1659.             End If
  1660.             
  1661.             Ydtext.Height = .CellHeight - Wbkpy1
  1662.       
  1663.             If GridInt(.Col, 2) <> 0 Then
  1664.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1665.             Else
  1666.                 Ydtext.MaxLength = 3000
  1667.             End If
  1668.       
  1669.             Call Wbkcl
  1670.       
  1671.             Ydtext.Visible = True
  1672.             Ydtext.SetFocus
  1673.         End If
  1674.         
  1675.         Dqtoprow = .TopRow
  1676.         Dqleftcol = .LeftCol
  1677.     
  1678.         '重置锁值
  1679.         Valilock = False
  1680.         Wbkbhlock = False
  1681.         
  1682.     End With
  1683.  
  1684. End Sub
  1686. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1687.    
  1688.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1689.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1690.         Exit Function
  1691.     End If
  1692.    
  1693.     '[>>
  1694.     
  1695.         '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1696.    
  1697.     '<<]
  1698.    
  1699.     Fun_AllowInput = True
  1700.     
  1701. End Function
  1703. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1704.                    
  1705.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1706.   
  1707.     Wbkpy = 30
  1708.     Wbkpy1 = 15
  1709.     
  1710.     With WglrGrid
  1711.         If YdCombo.Visible Then
  1712.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1713.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1714.             YdCombo.Width = .CellWidth - Wbkpy1
  1715.         End If
  1716.         If Ydcommand.Visible Then
  1717.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1718.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1719.         End If
  1720.         If Ydtext.Visible Then
  1721.             If Ydcommand.Visible Then
  1722.                 If Sfblbzkd Then
  1723.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1724.                 Else
  1725.                     Ydtext.Width = .CellWidth - Wbkpy1
  1726.                 End If
  1727.             Else
  1728.                 Ydtext.Width = .CellWidth - Wbkpy1
  1729.             End If
  1730.       
  1731.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1732.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1733.             Ydtext.Height = .CellHeight - Wbkpy1
  1734.         End If
  1735.    End With
  1737. End Sub
  1739. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1740.   
  1741.     With WglrGrid
  1742.         If YdCombo.Visible Then
  1743.             .Text = Trim(YdCombo.Text)
  1744.         End If
  1745.         If Ydtext.Visible Then
  1746.             .Text = Trim(Ydtext.Text)
  1747.         End If
  1748.    
  1749.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1750.         If Zdlrqnr <> Trim(.Text) Then
  1751.             Yxxpdlock = False
  1752.             Hyxxpdlock = False
  1753.         End If
  1754.    
  1755.         '如果字段录入内容不为空则写数据行有效性标志
  1756.    
  1757.         If Len(Trim(.Text)) <> 0 Then
  1758.             Call Xyxhbz(.Row)
  1759.         End If
  1760.    
  1761.         '隐藏文本框,帮助按钮,列表组合框
  1762.         Call Ycwbk
  1763.     End With
  1764.     
  1765. End Sub
  1767. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1768.     If Xtyear <> GTempYear Then
  1769.         Exit Sub
  1770.     End If
  1771.     '如果单据操作状态为浏览状态则不能显示录入载体
  1772.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1773.         Exit Sub
  1774.     End If
  1776.     Select Case KeyCode
  1777.         Case vbKeyF2                   '按F2键参照
  1778.             Call xswbk
  1779.         Call Lrzdbz
  1780.             Case vbKeyDelete               '删行
  1781.         Call Scdqfl
  1782.             Case vbKeyInsert               '增行
  1783.         Call zjlrfl
  1784.     End Select
  1785.     
  1786. End Sub
  1788. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1789.     If Xtyear <> GTempYear Then
  1790.         Exit Sub
  1791.     End If
  1792.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1793.     If Not Fun_AllowInput Then
  1794.         Exit Sub
  1795.     End If
  1796.   
  1797.     With WglrGrid
  1798.   
  1799.         '屏 蔽 回 车 键
  1800.         If KeyAscii = vbKeyReturn Then
  1801.             KeyAscii = 0
  1802.             Rowjsq = .Row
  1803.             Coljsq = .Col + 1
  1804.             If Coljsq > .Cols - 1 Then
  1805.                 If Rowjsq < .Rows - 1 Then
  1806.                     Rowjsq = Rowjsq + 1
  1807.                 End If
  1808.                 Coljsq = Qslz
  1809.             End If
  1810.             Do While Rowjsq <= .Rows - 1
  1811.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1812.                     Coljsq = Coljsq + 1
  1813.                     If Coljsq > .Cols - 1 Then
  1814.                         Rowjsq = Rowjsq + 1
  1815.                         Coljsq = Qslz
  1816.                     End If
  1817.                 Else
  1818.                     Exit Do
  1819.                 End If
  1820.             Loop
  1821.           
  1822.             If Rowjsq <= .Rows - 1 Then
  1823.                .Select Rowjsq, Coljsq
  1824.             End If
  1825.        
  1826.              Exit Sub
  1827.         End If
  1828.      
  1829.         '接受用户录入
  1830.         Select Case KeyAscii
  1831.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1832.           
  1833.                 '显示录入载体
  1834.                 Call xswbk
  1836.             Case Else
  1838.                 '防止非编辑字段SendKeys()出现死循环
  1839.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1840.                    Exit Sub
  1841.                 End If
  1843.                 '如果此字段为列表框录入则调入相应列表框
  1844.                 If GridBoolean(.Col, 3) Then
  1846.                     '列表框录入
  1847.                     Call xswbk
  1848.                 Else
  1850.                     Ydtext.Text = ""
  1851.             
  1852.                     '录入限制
  1853.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1854.             
  1855.                     If KeyAscii = 0 Then
  1856.                         Exit Sub
  1857.                     End If
  1859.                     '如果录入字符有效则写有效行数据标志
  1860.                     Call Xyxhbz(.Row)
  1861.                     Call xswbk
  1862.                     Ydtext.Text = ""
  1863.                     Valilock = True
  1864.                     SendKeys Chr(KeyAscii), True
  1865.                     DoEvents
  1866.                     Valilock = False
  1867.                 End If
  1868.         End Select
  1869.     End With
  1870.         
  1871. End Sub
  1873. Private Sub zjlrfl()                                                    '增加录入分录
  1874.   
  1875.     With WglrGrid
  1876.   
  1877.         '处于录入状态不能增行
  1878.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1879.             If Not Fun_Drfrmyxxpd Then
  1880.                 Exit Sub
  1881.             End If
  1882.         Else
  1883.             Exit Sub
  1884.         End If
  1885.     
  1886.         '处于非数据行和最后一行时不能增行
  1887.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1888.             Exit Sub
  1889.         End If
  1890.     
  1891.         .AddItem "", .Row
  1892.         .RowHeight(.Row) = Sjhgd
  1893.     
  1894.         If .Row <> .Rows - 1 Then
  1895.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1896.                 .TextMatrix(.Row, 0) = "*"
  1897.             Else
  1898.                 .RemoveItem .Rows - 1
  1899.             End If
  1900.         End If
  1901.         Call Xldqh
  1902.         Call Xldql
  1903.         Hyxxpdlock = False
  1904.     End With
  1905.     
  1906. End Sub
  1908. Private Sub Scdqfl()                                                    '删除当前分录
  1909.  
  1910.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1911.     Dim Sqlstr As String   '临时使用连接字符串
  1912.     Dim Coljsq As Long
  1913.     If Xtyear <> GTempYear Then
  1914.         Exit Sub
  1915.     End If
  1916.     With WglrGrid
  1917.         Scqwghz = .Row
  1918.         Scqwglz = .Col
  1919.         
  1920.         If .TextMatrix(.Row, 0) = "*" Then
  1921.             '判断是否为录入状态
  1922.             If Ydtext.Visible Or YdCombo.Visible Then
  1923.                 Sflrzt = True
  1924.                 Validate = True
  1925.                 Call Lrsjhx
  1926.                 Validate = False
  1927.             End If
  1928.        
  1929.             Call Xldqh
  1930.             Changelock = True
  1931.             .Select .Row, 0
  1932.             Changelock = False
  1933.             If Shsfts Then
  1934.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1935.                 Tsxx = "请确认是否删除当前记录?"
  1936.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1937.                 If Yhanswer = 2 Then
  1938.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1939.                     Changelock = True
  1940.                     .Select Scqwghz, Scqwglz
  1941.                     Changelock = False
  1942.               
  1943.                     '如为录入状态,则恢复录入
  1944.                     If Sflrzt Then
  1945.                        Call xswbk
  1946.                     End If
  1947.               
  1948.                     Exit Sub
  1949.                 End If
  1950.             End If
  1951.        
  1952.             '[>>以下为自定义部分
  1953.        
  1954.             On Error GoTo Swcwcl
  1955.     
  1956.             Cw_DataEnvi.DataConnect.BeginTrans
  1957.        
  1958.             If Trim(WglrGrid.TextMatrix(.Row, 35)) <> "" Then
  1959.                 Sqlstr = "Delete Xs_Plan From Xs_Plan WHERE PersonCode = '" & Trim(WglrGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) & "' And WareCode = '" & Trim(WglrGrid.TextMatrix(.Row, Sydz("003", GridStr(), Szzls))) & "'"
  1960.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1961.             End If
  1962.        
  1963.             Cw_DataEnvi.DataConnect.CommitTrans
  1964.        
  1965.             '<<以上为自定义部分]
  1966.        
  1967.             .RemoveItem .Row
  1968.  
  1969.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1970.                 .AddItem ""
  1971.                 .RowHeight(.Rows - 1) = Sjhgd
  1972.             End If
  1973.             For Coljsq = Qslz To .Cols - 1
  1974.                 Call Sjhj(Coljsq)
  1975.             Next Coljsq
  1976.             Changelock = True
  1977.             .Select .Row, Scqwglz
  1978.             Changelock = False
  1979.         End If
  1980.         
  1981.     End With
  1982.  
  1983.     Exit Sub
  1984.  
  1985.     '[>>事务错误处理
  1986.     
  1987. Swcwcl:
  1989.     Cw_DataEnvi.DataConnect.RollbackTrans
  1990.     
  1991.     Tsxx = "删除过程中出现错误!"
  1992.     Call Xtxxts(Tsxx, 0, 1)
  1993.     Exit Sub
  1994.     '<<]
  1995. End Sub
  1997. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1999.     If Not GridBoolean(Sjl, 5) Then
  2000.         Exit Sub
  2001.     End If
  2002.     
  2003.     With WglrGrid
  2004.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  2005.             .TextMatrix(sjh, Sjl) = ""
  2006.         End If
  2007.     End With
  2008.   
  2009. End Sub
  2011. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  2012.   
  2013.     With WglrGrid
  2014.         If .Row >= .FixedRows Then
  2015.             If .TextMatrix(.Row, 0) <> "*" Then
  2016.                 For Rowjsq = .FixedRows To .Rows - 1
  2017.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  2018.                         Exit For
  2019.                     End If
  2020.                 Next Rowjsq
  2021.                 If Rowjsq <= .Rows - 1 Then
  2022.                     Changelock = True
  2023.                     .Select Rowjsq, .Col
  2024.                     Changelock = False
  2025.                 Else
  2026.                     Changelock = True
  2027.                     .Select .Rows - 1, .Col
  2028.                     Changelock = False
  2029.                 End If
  2030.             End If
  2031.             Call Xldqh
  2032.         End If
  2033.   End With
  2034.   
  2035. End Sub
  2037. Private Sub Xldqh()                                                      '显露当前行
  2039.     Dim Toprowte As Long
  2040.     
  2041.     With WglrGrid
  2042.         Toprowte = 0
  2043.         
  2044.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  2045.             Toprowte = .TopRow
  2046.             .TopRow = .TopRow + 1
  2047.         Loop
  2048.         
  2049.         Toprowte = 0
  2050.         
  2051.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  2052.             Toprowte = .TopRow
  2053.             .TopRow = .TopRow - 1
  2054.         Loop
  2055.     End With
  2056.     
  2057. End Sub
  2059. Private Sub Xldql()                                                     '显露当前列
  2060.  
  2061.     Dim Leftcolte As Long
  2062.     
  2063.     With WglrGrid
  2064.         If .Col >= Qslz And .Col >= .FixedCols Then
  2065.             If .LeftCol > .Col Then
  2066.                 .LeftCol = .Col
  2067.             End If
  2068.             Leftcolte = 0
  2069.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  2070.                 Leftcolte = .LeftCol
  2071.                 .LeftCol = .LeftCol + 1
  2072.             Loop
  2073.         End If
  2074.     End With
  2075.     
  2076. End Sub
  2078. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  2079.  
  2080.     With WglrGrid
  2081.         For Coljsq = Qslz To .Cols - 1
  2082.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  2083.                 pdhwk = False
  2084.                 Exit Function
  2085.             End If
  2086.         Next Coljsq
  2087.         pdhwk = True
  2088.     End With
  2089.     
  2090. End Function
  2092. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  2093.    
  2094.    With WglrGrid
  2095.         If .TextMatrix(sjh, 0) = "*" Then
  2096.             Exit Sub
  2097.         End If
  2098.         .TextMatrix(sjh, 0) = "*"
  2099.         If sjh >= .Rows - Fzxwghs - 1 Then
  2100.             .AddItem "", .Rows - 1
  2101.             .RowHeight(.Rows - 1) = Sjhgd
  2102.         End If
  2103.    End With
  2104.    
  2105. End Sub
  2107. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  2108.     
  2109.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  2111. End Sub
  2113. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  2114.     
  2115.     Select Case Button.Key
  2116.         Case "bcgs"                                       '保存表格格式
  2117.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  2118.         Case "hfmrgs"                                     '恢复默认格式
  2119.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  2120.     End Select
  2121.     
  2122. End Sub
  2124. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  2125.   
  2126.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  2127.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  2128.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  2129.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  2130.     ReDim Bbxbt(1 To Bbxbtgs)
  2131.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  2132.     
  2133.     If Bbbwhgs <> 0 Then
  2134.         ReDim Bbbwh(1 To Bbbwhgs)
  2135.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  2136.     End If
  2137.     
  2138.     Bbzbt = ReportTitle
  2139.     Bbxbt(1) = Space(2) + Fun_FormatOutPut("部门:" + Trim(Label1(1).Caption), 40)
  2140.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("会计年度:" + Trim(Label1(3).Caption), 30)
  2141.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  2142.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  2143.   
  2144.     If Not bbylte Then
  2145.         Unload DY_Tybbyldy
  2146.     End If
  2147.     
  2148. End Sub