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

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

企业管理

开发平台：

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