English
资源名称：ERPSYS.zip [点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：112k
源码类别：
企业管理
开发平台：
Visual Basic
- VERSION 5.00
- Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
- Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
- Begin VB.Form Cg_FrmPlanSplit
- BackColor = &H00E9F4FA&
- BorderStyle = 3 'Fixed Dialog
- Caption = "采购计划拆分"
- ClientHeight = 6555
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 9915
- Icon = "采购系统_采购计划拆分.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 6555
- ScaleWidth = 9915
- ShowInTaskbar = 0 'False
- StartUpPosition = 1 '所有者中心
- Begin VB.ComboBox YdCombo
- Height = 300
- Left = 7890
- Style = 2 'Dropdown List
- TabIndex = 11
- Top = 1080
- Visible = 0 'False
- Width = 1151
- End
- Begin VB.CommandButton Ydcommand
- CausesValidation= 0 'False
- Height = 299
- Left = 9600
- Picture = "采购系统_采购计划拆分.frx":1042
- Style = 1 'Graphical
- TabIndex = 1
- Top = 570
- Visible = 0 'False
- Width = 283
- End
- Begin VB.CommandButton YdCommand1
- CausesValidation= 0 'False
- Height = 299
- Left = 9600
- Picture = "采购系统_采购计划拆分.frx":13CC
- Style = 1 'Graphical
- TabIndex = 9
- Top = 870
- Visible = 0 'False
- Width = 283
- End
- Begin VB.TextBox Ydtext
- BackColor = &H80000018&
- BorderStyle = 0 'None
- ForeColor = &H00000000&
- Height = 339
- Left = 7770
- MultiLine = -1 'True
- TabIndex = 2
- Top = 630
- Visible = 0 'False
- Width = 1181
- End
- Begin VSFlex8Ctl.VSFlexGrid WglrGrid
- Height = 4530
- Left = 60
- TabIndex = 0
- Top = 1830
- Width = 9570
- _cx = 5080
- _cy = 5080
- Appearance = 1
- BorderStyle = 1
- Enabled = -1 'True
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- MousePointer = 0
- BackColor = 16777215
- ForeColor = 0
- BackColorFixed = 14671839
- ForeColorFixed = 0
- BackColorSel = -2147483643
- ForeColorSel = -2147483639
- BackColorBkg = -2147483636
- BackColorAlternate= 16777215
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 1
- AllowSelection = 0 'False
- AllowBigSelection= 0 'False
- AllowUserResizing= 1
- SelectionMode = 0
- GridLines = 1
- GridLinesFixed = 2
- GridLineWidth = 1
- Rows = 5000
- Cols = 10
- FixedRows = 1
- FixedCols = 0
- RowHeightMin = 0
- RowHeightMax = 0
- ColWidthMin = 0
- ColWidthMax = 0
- ExtendLastCol = 0 'False
- FormatString = ""
- ScrollTrack = 0 'False
- ScrollBars = 3
- ScrollTips = 0 'False
- MergeCells = 0
- MergeCompare = 0
- AutoResize = -1 'True
- AutoSizeMode = 0
- AutoSearch = 0
- AutoSearchDelay = 2
- MultiTotals = -1 'True
- SubtotalPosition= 1
- OutlineBar = 0
- OutlineCol = 0
- Ellipsis = 0
- ExplorerBar = 0
- PicturesOver = 0 'False
- FillStyle = 0
- RightToLeft = 0 'False
- PictureType = 0
- TabBehavior = 0
- OwnerDraw = 0
- Editable = 0
- ShowComboButton = 1
- WordWrap = -1 'True
- TextStyle = 0
- TextStyleFixed = 0
- OleDragMode = 0
- OleDropMode = 0
- DataMode = 0
- VirtualData = -1 'True
- DataMember = ""
- ComboSearch = 3
- AutoSizeMouse = -1 'True
- FrozenRows = 0
- FrozenCols = 0
- AllowUserFreezing= 0
- BackColorFrozen = 0
- ForeColorFrozen = 0
- WallPaperAlignment= 9
- AccessibleName = ""
- AccessibleDescription= ""
- AccessibleValue = ""
- AccessibleRole = 24
- Begin VSFlex8Ctl.VSFlexGrid HjGrid
- Height = 690
- Left = 0
- TabIndex = 12
- Top = -2761
- Width = 8970
- _cx = 5080
- _cy = 5080
- Appearance = 1
- BorderStyle = 0
- Enabled = -1 'True
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- MousePointer = 0
- BackColor = -2147483624
- ForeColor = -2147483640
- BackColorFixed = -2147483633
- ForeColorFixed = -2147483630
- BackColorSel = -2147483643
- ForeColorSel = -2147483640
- BackColorBkg = -2147483636
- BackColorAlternate= -2147483624
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 0
- AllowSelection = 0 'False
- AllowBigSelection= 0 'False
- AllowUserResizing= 0
- SelectionMode = 0
- GridLines = 1
- GridLinesFixed = 2
- GridLineWidth = 1
- Rows = 5000
- Cols = 10
- FixedRows = 0
- FixedCols = 0
- RowHeightMin = 0
- RowHeightMax = 0
- ColWidthMin = 0
- ColWidthMax = 0
- ExtendLastCol = 0 'False
- FormatString = ""
- ScrollTrack = 0 'False
- ScrollBars = 3
- ScrollTips = 0 'False
- MergeCells = 0
- MergeCompare = 0
- AutoResize = -1 'True
- AutoSizeMode = 0
- AutoSearch = 0
- AutoSearchDelay = 2
- MultiTotals = -1 'True
- SubtotalPosition= 1
- OutlineBar = 0
- OutlineCol = 0
- Ellipsis = 0
- ExplorerBar = 0
- PicturesOver = 0 'False
- FillStyle = 0
- RightToLeft = 0 'False
- PictureType = 0
- TabBehavior = 0
- OwnerDraw = 0
- Editable = 0
- ShowComboButton = 1
- WordWrap = -1 'True
- TextStyle = 0
- TextStyleFixed = 0
- OleDragMode = 0
- OleDropMode = 0
- DataMode = 0
- VirtualData = -1 'True
- DataMember = ""
- ComboSearch = 3
- AutoSizeMouse = -1 'True
- FrozenRows = 0
- FrozenCols = 0
- AllowUserFreezing= 0
- BackColorFrozen = 0
- ForeColorFrozen = 0
- WallPaperAlignment= 9
- AccessibleName = ""
- AccessibleDescription= ""
- AccessibleValue = ""
- AccessibleRole = 24
- End
- End
- Begin MSComctlLib.ImageList Imagelist1
- Left = 9300
- Top = 1230
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 42
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":1756
- Key = "sz"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":1AF0
- Key = "dy"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":1E8A
- Key = "yl"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":2224
- Key = "xz"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":25BE
- Key = "xg"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":2958
- Key = "sc"
- EndProperty
- BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":2CF2
- Key = "zh"
- EndProperty
- BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":308C
- Key = "sh"
- EndProperty
- BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":3426
- Key = "bc"
- EndProperty
- BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":37C0
- Key = "fq"
- EndProperty
- BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":3B5A
- Key = "check"
- EndProperty
- BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":3EF4
- Key = "qs"
- EndProperty
- BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":428E
- Key = "fullcheck"
- EndProperty
- BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":4628
- Key = "qq"
- EndProperty
- BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":49C2
- Key = "first"
- EndProperty
- BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":4D5C
- Key = "prev"
- EndProperty
- BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":50F6
- Key = "next"
- EndProperty
- BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":5490
- Key = "last"
- EndProperty
- BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":582A
- Key = "bz"
- EndProperty
- BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":5BC4
- Key = "tc"
- EndProperty
- BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":5F5E
- Key = "bcgs"
- EndProperty
- BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":62F8
- Key = "mrlk"
- EndProperty
- BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":6692
- Key = "xsxm"
- EndProperty
- BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":6A2C
- Key = "hz"
- EndProperty
- BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":6DC6
- Key = "dw"
- EndProperty
- BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":7160
- Key = "zx"
- EndProperty
- BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":74FA
- Key = "mx"
- EndProperty
- BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":7894
- Key = "hf"
- EndProperty
- BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":7C2E
- Key = "cx"
- EndProperty
- BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":7FC8
- Key = "sx"
- EndProperty
- BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":8362
- Key = "dj"
- EndProperty
- BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":86FC
- Key = "tb"
- EndProperty
- BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":8A96
- Key = "px"
- EndProperty
- BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":8E30
- Key = "zq"
- EndProperty
- BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":91CA
- Key = "wc"
- EndProperty
- BeginProperty ListImage36 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":9564
- Key = "ye"
- EndProperty
- BeginProperty ListImage37 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":98FE
- Key = "zz"
- EndProperty
- BeginProperty ListImage38 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":9C98
- Key = "jz"
- EndProperty
- BeginProperty ListImage39 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":A032
- Key = "xx"
- EndProperty
- BeginProperty ListImage40 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":A3CC
- Key = "ph"
- EndProperty
- BeginProperty ListImage41 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":A766
- Key = "dz"
- EndProperty
- BeginProperty ListImage42 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_采购计划拆分.frx":AB00
- Key = "cf"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.Toolbar Tlb_Action
- Align = 1 'Align Top
- Height = 555
- Left = 0
- TabIndex = 10
- Top = 0
- Width = 9915
- _ExtentX = 17489
- _ExtentY = 979
- ButtonWidth = 820
- ButtonHeight = 926
- AllowCustomize = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "Imagelist1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 34
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "设置"
- Key = "ymsz"
- Object.ToolTipText = "打印页面设置"
- ImageKey = "sz"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "打印"
- Key = "dy"
- ImageKey = "dy"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "预览"
- Key = "yl"
- ImageKey = "yl"
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "bKey1"
- Style = 3
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "新增"
- Key = "xz"
- Object.ToolTipText = "新增加一张单据或F5"
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "修改"
- Key = "xg"
- Object.ToolTipText = "修改当前单据"
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "删除"
- Key = "sc"
- Object.ToolTipText = "删除当前单据"
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Key = "bKey2"
- Style = 3
- EndProperty
- BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "增行"
- Key = "zh"
- Object.ToolTipText = "插入一行"
- ImageKey = "zh"
- EndProperty
- BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "删行"
- Key = "sh"
- Object.ToolTipText = "删除当前记录行"
- ImageKey = "sh"
- EndProperty
- BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "bKey3"
- Style = 3
- EndProperty
- BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "保存"
- Key = "bc"
- Object.ToolTipText = "保存单据"
- ImageKey = "bc"
- EndProperty
- BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Object.Visible = 0 'False
- Caption = "放弃"
- Key = "fq"
- Object.ToolTipText = "放弃此次操作"
- ImageKey = "fq"
- EndProperty
- BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Key = "bKey4"
- Style = 3
- EndProperty
- BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "查询"
- Key = "cx"
- EndProperty
- BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Key = "bKey5"
- Style = 3
- EndProperty
- BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "审核"
- Key = "Check"
- Object.ToolTipText = "查询科目最新余额"
- EndProperty
- BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "弃审"
- Key = "Uncheck"
- Object.ToolTipText = "填制凭证选项"
- EndProperty
- BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "全审"
- Key = "CheckAll"
- EndProperty
- BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "全弃"
- Key = "UncheckAll"
- EndProperty
- BeginProperty Button21 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Key = "sCheck"
- Style = 3
- EndProperty
- BeginProperty Button22 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "执行"
- Key = "Exec"
- EndProperty
- BeginProperty Button23 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "弃执"
- Key = "Unexec"
- EndProperty
- BeginProperty Button24 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "全执"
- Key = "ExecAll"
- EndProperty
- BeginProperty Button25 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "全弃"
- Key = "UnexecAll"
- EndProperty
- BeginProperty Button26 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Key = "sExec"
- Style = 3
- EndProperty
- BeginProperty Button27 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Key = "fgh"
- Style = 3
- EndProperty
- BeginProperty Button28 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "首张"
- Key = "first"
- EndProperty
- BeginProperty Button29 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "上张"
- Key = "prev"
- EndProperty
- BeginProperty Button30 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "下张"
- Key = "next"
- EndProperty
- BeginProperty Button31 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "末张"
- Key = "last"
- EndProperty
- BeginProperty Button32 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "bKey6"
- Style = 3
- EndProperty
- BeginProperty Button33 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "帮助"
- Key = "bz"
- ImageKey = "bz"
- EndProperty
- BeginProperty Button34 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "退出"
- Key = "fh"
- ImageKey = "tc"
- EndProperty
- EndProperty
- BorderStyle = 1
- End
- Begin VB.Label Lab_MakeBill
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BackStyle = 0 'Transparent
- ForeColor = &H80000008&
- Height = 285
- Left = 780
- TabIndex = 8
- Top = 6240
- Width = 960
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "审核："
- Height = 195
- Index = 0
- Left = 4917
- TabIndex = 7
- Top = 7457
- Width = 540
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "制单:"
- Height = 180
- Index = 8
- Left = 180
- TabIndex = 6
- Top = 6240
- Width = 450
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- BackColor = &H80000018&
- BackStyle = 0 'Transparent
- Caption = "采购计划拆分"
- BeginProperty Font
- Name = "宋体"
- Size = 14.25
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00000000&
- Height = 285
- Index = 4
- Left = 4020
- TabIndex = 5
- Top = 960
- Width = 1800
- End
- Begin VB.Label Lab_Pzclzt
- BackColor = &H80000018&
- Caption = "1"
- ForeColor = &H00808080&
- Height = 255
- Left = 9240
- TabIndex = 4
- Top = 990
- Visible = 0 'False
- Width = 285
- End
- Begin VB.Label Lab_OperStatus
- BackColor = &H000080FF&
- Caption = "1"
- Height = 345
- Left = 9180
- TabIndex = 3
- Top = 570
- Visible = 0 'False
- Width = 345
- End
- End
- Attribute VB_Name = "Cg_FrmPlanSplit"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '*********************************************************************************************************
- '* 模 块 名 称 :采购计划拆分
- '* 功 能 描 述 :此功能模块主要完成采购计划的拆分。
- '* 程序员姓名 : 李海祥
- '* 最后修改人 : 李海祥
- '* 最后修改时间:2001/07/19
- '* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
- '*
- '* 1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
- '*
- '* 2.网格列存储内容注解
- '*
- '* 3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) "1"-浏览 "2"-新增 "3"-修改 "4"-删除
- '*
- '* 4.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
- '*
- '*********************************************************************************************************
- '[以下为根据实际情况设置变量
- Dim Tsxx As String
- Dim int_FrmState As Integer '表示为窗体的状态 1、新增 2、维护 3、查询
- Public dbl_RecordAutoCode As Double '当前编辑计划纪录的记录号
- Public bln_Help As Boolean
- Public rs_PlanSearch As New ADODB.Recordset '满足条件的记录集
- Public rs_PAutoID As New ADODB.Recordset
- Public bln_IsChanged As Boolean
- Dim Material_Num() As Double '拆分前物料总数量
- Dim Material_Str() As String
- Dim Lng_KjYear As Long
- Dim Lng_Period As Long
- Public plan_material_num As Long
- Dim arrDbl_Quan() As Double
- Dim arrStr_MNum() As String
- Dim arrStr_LeftMNum() As String
- Dim arrDbl_LeftQuan() As Double
- Dim arrStr_PackType() As String
- Dim arrStr_TrafficMode() As String
- Dim arrStr_Execer() As String
- Dim rs_From(1) As New ADODB.Recordset
- '**************************bfy]
- '以下为固定使用变量(网格)
- Dim Cxnrrec As New ADODB.Recordset '显示查询内容动态集
- Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
- Dim GridCode As String '显示网格网格代码
- Dim GridInf() As Variant '整个网格设置信息
- Dim ReportTitle As String '报表主标题
- Dim Pmbcsjhs As Long '屏幕网格保持数据行数(大于等于1)
- Dim Fzxwghs As Integer '辅助项网格行数(包括合计行)
- Dim Sfxshjwg As Boolean '是否显示合计网格
- Dim Qslz As Long '网格隐藏(非操作显示)列数
- Dim Sjhgd As Double '网格数据行高度
- Dim GridBoolean() As Boolean '网格列信息(布尔型)
- Dim GridStr() As String '网格列信息(字符型)
- Dim GridInt() As Integer '网格列信息(整型)
- Dim Sfblbzkd As Boolean '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
- Dim Dqlrwgh As Long '当前录入数据网格行
- Dim Dqlrwgl As Long '当前录入数据网格列
- Dim Dqlkwgh As Long '刚刚离开网格行(不一定为录入行)
- Dim Dqlkwgl As Long '刚刚离开网格列
- Dim Dqtoprow As Long '当前录入状态时最上端可视行
- Dim Dqleftcol As Long '当前录入状态时最左端可视列
- Dim Zdlrqnr As String '字段录入修改前内容(用来判断内容是否修改)
- Dim Wbkbhlock As Boolean '文本框改变值锁
- Dim Changelock As Boolean '网格行列改变控制锁(用来区别用户改变.程序改变)
- Dim Gdtlock As Boolean '滚动条滚动控制(用来区别用户改变.程序改变)
- Dim Yxxpdlock As Boolean '字段有效性判断锁(内容不修改不需进行字段有效性判断)
- Dim Hyxxpdlock As Boolean '行有效性判断锁(字段内容不修改不需进行行有效性判断)
- Dim Valilock As Boolean '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
- Dim Shsfts As Boolean '删除记录行是否提示
- Dim Szzls As Integer '网格信息数组最大下标值(网格列数-1)
- '以下为固定使用变量(文本框)
- Dim Textvar() As Variant '存储变体型文本框信息
- Dim Textboolean() As Boolean '存储布尔型文本框信息
- Dim Textint() As Integer '存储整型文本框信息
- Dim Textstr() As String '存储字符型文本框信息
- Dim Max_Text_Index As Integer '最大录入文本框索引值
- Dim TextGroupCode As String '文本框录入分组编码
- Dim TextValiLock As Boolean '文本框失去焦点是否进行有效性控制判断
- Dim TextValiJudgeLock() As Boolean '文本框录入有效性判断控制锁
- Dim TextChangeLock As Boolean '文本框内容变换控制锁
- Dim Bln_Cancel As Boolean '取消按钮信息传递
- Private Function FnBln_SaveData(int_OperStatus As Integer) As Boolean
- FnBln_SaveData = True
- Dim i As Long
- Dim Lng_Jsq As Long
- Dim str_SQlSave As String
- Dim rs_Save(1) As New ADODB.Recordset ' 保存记录集
- Dim Int_Year As Integer
- Dim Int_Period As Integer
- Dim str_SQLAssi As String
- Dim rs_SQLAssi As New ADODB.Recordset
- Dim str_Insert As String
- Dim rs_Temp As New ADODB.Recordset
- Dim Lng_Cfpc As Long '同次拆分过程号
- Dim Rs_Plan As New ADODB.Recordset '有生产厂家的记录单独保存
- Dim Rs_Plan1 As New ADODB.Recordset
- Cw_DataEnvi.DataConnect.BeginTrans
- '保存拆分数量
- On Error GoTo error_manager
- Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(" select Max(SplitUniteNum) as MSplitUniteNum from Cg_PurPlanMain")
- Lng_Cfpc = rs_Temp.Fields("MSplitUniteNum") + 1
- Set rs_Temp = Nothing
- For i = Me.WglrGrid.FixedRows To Me.WglrGrid.Rows - 1
- If Me.WglrGrid.TextMatrix(i, 0) = "*" Then
- '保存主表
- str_SQlSave = "select * from Cg_PurPlanMain where 1=2"
- If rs_Save(0).State = 1 Then rs_Save(0).Close
- rs_Save(0).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
- With rs_Save(0)
- .AddNew
- .Fields("PurPlanNum") = CreatBillCode("1101", True) '计划单号
- .Fields("KjYear") = Lng_KjYear '会计年度
- .Fields("Period") = Lng_Period '会计月份
- .Fields("PurPlanDate") = Format(Xtrq, "yyyy-mm-dd") '计划日期
- .Fields("PurPlanType") = "拆分生成" '计划类型
- .Fields("DeptCode") = rs_From(0).Fields("DeptCode") '计划部门
- .Fields("PersonCode") = rs_From(0).Fields("PersonCode") '计划人
- .Fields("ExigenceFlag") = rs_From(0).Fields("ExigenceFlag") '紧急标志
- If Trim(Me.WglrGrid.TextMatrix(i, 1)) <> "" Then
- .Fields("SupplierCode") = Trim(Me.WglrGrid.TextMatrix(i, 1)) '供应商
- End If
- .Fields("Maker") = Xtczy '制单人
- .Fields("Checker") = Xtczy '审核人
- .Fields("Remark") = Trim(rs_From(0).Fields("Remark") & "") '备注
- .Fields("Transmitter") = "" '下达人置空
- .Fields("FinishFlag") = 0 '完成标志
- .Fields("SplitUniteFlag") = 0 '拆合标志
- .Fields("PurPlanStyle") = "2" '不能被生产系统调用
- .Fields("PurPlanMainID") = CreatBillID("1101") '单据ID
- .Fields("SplitUniteNum") = Lng_Cfpc '拆分合并过程号
- .UpdateBatch
- End With
- '保存从表
- str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
- If rs_Save(1).State = 1 Then rs_Save(1).Close
- rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
- With rs_Save(1)
- .AddNew
- .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0 '单据ID
- .Fields("MNumber") = Trim(Me.WglrGrid.TextMatrix(i, Sydz("001", GridStr(), Szzls))) '物料编码
- .Fields("Quantity") = S2N(Me.WglrGrid.TextMatrix(i, Sydz("006", GridStr(), Szzls))) '数量
- .Fields("Buyer") = "" '采购员
- .Fields("PurPlanSubID") = 1 '子表ID
- .Fields("ProcFactory") = "" '生产厂家
- .UpdateBatch
- str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & rs_Save(1).Fields("PurPlanSubID") & "," & rs_From(0).Fields("PurPlanMainID") & ",1)"
- Cw_DataEnvi.DataConnect.Execute (str_Insert)
- End With
- End If
- Next i
- ' 保存剩余单据
- Dim Is_Left As Boolean
- Is_Left = False
- For i = LBound(arrStr_LeftMNum, 1) To UBound(arrStr_LeftMNum, 1)
- If arrDbl_LeftQuan(i) <> 0 Then
- Is_Left = True
- Exit For
- End If
- Next i
- If Is_Left Then
- str_SQlSave = "select * from Cg_PurPlanMain where 1=2"
- If rs_Save(0).State = 1 Then rs_Save(0).Close
- rs_Save(0).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
- With rs_Save(0)
- .AddNew
- .Fields("PurPlanNum") = CreatBillCode("1101", True) '单据号
- .Fields("KjYear") = Lng_KjYear '会计年度
- .Fields("Period") = Lng_Period '会计月份
- .Fields("PurPlanDate") = Format(Xtrq, "yyyy-mm-dd") '计划日期
- .Fields("PurPlanType") = "拆分生成" '计划类型
- .Fields("DeptCode") = rs_From(0).Fields("DeptCode") '计划部门
- .Fields("PersonCode") = rs_From(0).Fields("PersonCode") '计划人
- .Fields("ExigenceFlag") = rs_From(0).Fields("ExigenceFlag") '紧急标志
- .Fields("SupplierCode") = rs_From(0).Fields("SupplierCode") '供应商
- .Fields("Maker") = Xtczy '制单人
- .Fields("Checker") = Xtczy '审核人
- .Fields("Remark") = Trim(rs_From(0).Fields("Remark") & "") '备注
- .Fields("Transmitter") = "" '下达人置空
- .Fields("FinishFlag") = 0 '完成标志
- .Fields("SplitUniteFlag") = 0 '拆合标志
- .Fields("PurPlanStyle") = "2" '不能被生产系统调用
- .Fields("PurPlanMainID") = CreatBillID("1101") '单据ID
- .Fields("SplitUniteNum") = Lng_Cfpc '拆分合并过程号
- .UpdateBatch
- End With
- '保存从表
- Lng_Jsq = 1
- For i = LBound(arrStr_LeftMNum, 1) To UBound(arrStr_LeftMNum, 1)
- If arrDbl_LeftQuan(i) <> 0 Then
- str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
- If rs_Save(1).State = 1 Then rs_Save(1).Close
- rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
- With rs_Save(1)
- .AddNew
- .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0 '单据ID
- .Fields("MNumber") = arrStr_LeftMNum(i) '物料编码
- .Fields("Quantity") = arrDbl_LeftQuan(i) '数量
- .Fields("Buyer") = "" '采购员
- .Fields("ProcFactory") = "" '生产厂家
- .Fields("PurPlanSubID") = Lng_Jsq '子表ID
- .UpdateBatch
- str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & rs_Save(1).Fields("PurPlanSubID") & "," & rs_From(0).Fields("PurPlanMainID") & "," & Lng_Jsq & ")"
- Cw_DataEnvi.DataConnect.Execute (str_Insert)
- End With
- Lng_Jsq = Lng_Jsq + 1
- End If
- Next i
- '保存有生产厂家的记录
- Set Rs_Plan = Cw_DataEnvi.DataConnect.Execute("Select * from Cg_V_PlanBill where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory<>'' ")
- Do While Not Rs_Plan.EOF()
- str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
- If rs_Save(1).State = 1 Then rs_Save(1).Close
- rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
- With rs_Save(1)
- .AddNew
- .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0 '单据ID
- .Fields("MNumber") = Rs_Plan.Fields("MNumber") '物料编码
- .Fields("Quantity") = Rs_Plan.Fields("Quantity") '数量
- .Fields("Buyer") = "" '采购员
- .Fields("PurPlanSubID") = Lng_Jsq '子表ID
- .Fields("ProcFactory") = Rs_Plan.Fields("ProcFactory") '生产厂家
- .UpdateBatch
- str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & Lng_Jsq & "," & rs_From(0).Fields("PurPlanMainID") & "," & Rs_Plan.Fields("PurPlanSubID") & " )"
- Cw_DataEnvi.DataConnect.Execute (str_Insert)
- End With
- Rs_Plan.MoveNext
- Lng_Jsq = Lng_Jsq + 1
- Loop
- Else
- '保存有生产厂家的记录
- Set Rs_Plan1 = Cw_DataEnvi.DataConnect.Execute("Select * from Cg_V_PlanBill where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory<>'' ")
- If Not Rs_Plan1.EOF Then
- str_SQlSave = "select * from Cg_PurPlanMain where 1=2"
- If rs_Save(0).State = 1 Then rs_Save(0).Close
- rs_Save(0).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
- With rs_Save(0)
- .AddNew
- .Fields("PurPlanNum") = CreatBillCode("1101", True) '单据号
- .Fields("KjYear") = Lng_KjYear '会计年度
- .Fields("Period") = Lng_Period '会计月份
- .Fields("PurPlanDate") = Format(Xtrq, "yyyy-mm-dd") '计划日期
- .Fields("PurPlanType") = "拆分生成" '计划类型
- .Fields("DeptCode") = rs_From(0).Fields("DeptCode") '计划部门
- .Fields("PersonCode") = rs_From(0).Fields("PersonCode") '计划人
- .Fields("ExigenceFlag") = rs_From(0).Fields("ExigenceFlag") '紧急标志
- .Fields("SupplierCode") = rs_From(0).Fields("SupplierCode") '供应商
- .Fields("Maker") = Xtczy '制单人
- .Fields("Checker") = Xtczy '审核人
- .Fields("Remark") = Trim(rs_From(0).Fields("Remark") & "") '备注
- .Fields("PurPlanStyle") = "2" '不能被生产系统调用
- .Fields("Transmitter") = "" '下达人置空
- .Fields("FinishFlag") = 0 '完成标志
- .Fields("SplitUniteFlag") = 0 '拆合标志
- .Fields("PurPlanMainID") = CreatBillID("1101") '单据ID
- .Fields("SplitUniteNum") = Lng_Cfpc '拆分合并过程号
- .UpdateBatch
- End With
- '保存从表
- Set Rs_Plan = Cw_DataEnvi.DataConnect.Execute("Select * from Cg_V_PlanBill where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory<>'' ")
- Lng_Jsq = 1
- Do While Not Rs_Plan.EOF()
- str_SQlSave = "select * from Cg_PurPlanSub where 1=2"
- If rs_Save(1).State = 1 Then rs_Save(1).Close
- rs_Save(1).Open str_SQlSave, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
- With rs_Save(1)
- .AddNew
- .Fields("PurPlanMainID") = rs_Save(0).Fields("PurPlanMainID") + 0 '单据ID
- .Fields("MNumber") = Rs_Plan.Fields("MNumber") '物料编码
- .Fields("Quantity") = Rs_Plan.Fields("Quantity") '数量
- .Fields("Buyer") = "" '采购员
- .Fields("PurPlanSubID") = Lng_Jsq '子表ID
- .Fields("ProcFactory") = Rs_Plan.Fields("ProcFactory") '生产厂家
- .UpdateBatch
- str_Insert = "insert into Cg_SplitUnite(SplitUniteNum,NewPurPlanMainID,NewPurPlanSubID,PurPlanMainID,PurPlanSubID)" & "values( " & Lng_Cfpc & "," & rs_Save(0).Fields("PurPlanMainID") & " ," & Lng_Jsq & "," & rs_From(0).Fields("PurPlanMainID") & "," & Rs_Plan.Fields("PurPlanSubID") & " )"
- Cw_DataEnvi.DataConnect.Execute (str_Insert)
- End With
- Rs_Plan.MoveNext
- Lng_Jsq = Lng_Jsq + 1
- Loop
- End If
- End If
- '隐藏原始单据
- Str_Temp = "select * from Cg_PurPlanMain where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and Checker=''"
- Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
- If Not rs_Temp.EOF() Then
- Call Xtxxts("该计划已经被其他人弃审，不能拆分!", 0, 1)
- Cw_DataEnvi.DataConnect.RollbackTrans
- FnBln_SaveData = False
- Exit Function
- End If
- Set rs_Temp = Nothing
- Str_Temp = "select * from Cg_PurPlanMain where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and Transmitter<>''"
- Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
- If Not rs_Temp.EOF() Then
- Call Xtxxts("该计划已经被其他人下达，不能拆分!", 0, 1)
- Cw_DataEnvi.DataConnect.RollbackTrans
- FnBln_SaveData = False
- Exit Function
- End If
- Set rs_Temp = Nothing
- Str_Temp = "update Cg_PurPlanMain set SplitUniteFlag=2 where PurPlanMainID='" & Me.dbl_RecordAutoCode & "'"
- Cw_DataEnvi.DataConnect.Execute (Str_Temp)
- Cw_DataEnvi.DataConnect.CommitTrans
- Exit Function
- Xtfhcs = "1"
- error_manager:
- Cw_DataEnvi.DataConnect.RollbackTrans
- Tsxx = "系统生成出现错误,系统恢复到原来状态!"
- Call Xtxxts(Tsxx, 0, 1)
- FnBln_SaveData = False
- End Function
- Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
- Select Case KeyAscii
- Case 39 '屏蔽字符"'"
- KeyAscii = 0
- End Select
- End Sub
- Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
- If Shift = 2 Then
- With Me.Tlb_Action
- Select Case KeyCode
- Case vbKeyP
- If .Buttons("dy").Enabled = True And .Buttons("dy").Visible = True Then
- Call Tlb_Action_ButtonClick(.Buttons("dy"))
- End If
- End Select
- End With
- End If
- End Sub
- Private Sub Form_Load() '窗 体 装 入
- Xtrq = Format(Xtrq, "yyyy-mm-dd")
- '初始化各种锁值
- Changelock = False '网格行列改变控制锁
- Gdtlock = False '滚动条滚动控制
- Yxxpdlock = True '字段有效性判断锁
- Hyxxpdlock = True '行有效性判断锁
- Wbkbhlock = False '文本框内容改变锁
- '报表主标题及报表编码
- ReportTitle = "采购计划拆分"
- XtReportCode = "Cg_PlanSplit"
- Load Dyymctbl
- '调 入 网 格
- GridCode = "Cg_PlanSplit" '网格属性编码
- Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
- Qslz = GridInf(1)
- Sjhgd = GridInf(2)
- Pmbcsjhs = GridInf(3)
- Fzxwghs = GridInf(4)
- Sfblbzkd = GridInf(5)
- Shsfts = GridInf(6)
- Sfxshjwg = GridInf(7)
- Szzls = WglrGrid.Cols - 1
- bln_IsChanged = False
- Xtfhcs = "0"
- With WglrGrid
- .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
- For jsqte = .FixedRows To .Rows - 1
- .RowHeight(jsqte) = Sjhgd
- Next jsqte
- .Clear 1
- Changelock = True
- .Select .FixedRows, Qslz
- Changelock = False
- For i = 0 To .Cols - 1
- If i = Sydz("006", GridStr(), Szzls) Then
- .ColAlignment(i) = flexAlignRightTop
- Else
- .ColAlignment(i) = flexAlignCenterCenter
- End If
- Next i
- End With
- '初始化工具栏，操作状态，显示数据（在由列表过渡到修改状态是用到）
- Call FrmTlbState(Me.PFrmTlbOprState)
- Me.Lab_MakeBill.Caption = Xtczy
- Me.Lab_MakeBill.Tag = Xtczybm
- Call Sub_OperStatus("1")
- Call Tlb_Action_ButtonClick(Me.Tlb_Action.Buttons("xz"))
- Me.dbl_RecordAutoCode = Cg_PlanUnitSplit.CxbbGrid.TextMatrix(Cg_PlanUnitSplit.CxbbGrid.Row, 0)
- With Cg_PlanUnitSplit.CxbbGrid
- Set rs_PlanSearch = Cw_DataEnvi.DataConnect.Execute("select KjYear,Period,MNumber,MName,Model,PurUnitName,Sum(Quantity) as SumQuantity from Cg_V_PlanBill where PurPlanMainID='" & .TextMatrix(.Row, 0) & "' and ProcFactory =''group by MNumber,MName,Model,PurUnitName,KjYear,Period")
- WglrGrid.TextMatrix(1, Sydz("001", GridStr(), Szzls)) = Trim(rs_PlanSearch!MNumber) '物料编码
- WglrGrid.TextMatrix(1, Sydz("002", GridStr(), Szzls)) = Trim("" & rs_PlanSearch!MName) '物料名称
- WglrGrid.TextMatrix(1, Sydz("003", GridStr(), Szzls)) = Trim("" & rs_PlanSearch!Model) '规格型号
- WglrGrid.TextMatrix(1, Sydz("004", GridStr(), Szzls)) = Trim("" & rs_PlanSearch!PurUnitName) '计量单位
- WglrGrid.TextMatrix(1, 0) = "*"
- WglrGrid.RowHeight(WglrGrid.Rows - 1) = Sjhgd
- ReDim Material_Num(rs_PlanSearch.RecordCount - 1)
- ReDim Material_Str(rs_PlanSearch.RecordCount - 1)
- Lng_KjYear = rs_PlanSearch.Fields("KjYear")
- Lng_Period = rs_PlanSearch.Fields("Period")
- Dim j As Long
- plan_material_num = rs_PlanSearch.RecordCount - 1
- j = 0
- Do While Not rs_PlanSearch.EOF()
- Material_Num(j) = S2N(Trim(rs_PlanSearch("SumQuantity")))
- Material_Str(j) = Trim(rs_PlanSearch("MNumber"))
- rs_PlanSearch.MoveNext
- j = j + 1
- Loop
- End With
- WglrGrid.Enabled = True
- End Sub
- Private Sub Form_Unload(Cancel As Integer) '窗体卸载
- '清除查询条件
- ReDim Cxckbm(0)
- ReDim Cxdjbh(0)
- Me.dbl_RecordAutoCode = 0
- Cxdjgs = 0
- Hqssckbm = ""
- Hwsshqbm = ""
- '卸载打印页面窗体
- Unload Dyymctbl
- End Sub
- Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
- '[>>根据实际情况初始化
- Select Case Str_Pzclzt
- Case "1" '新增记录
- '日期默认值为用户选择日期
- '设置操作状态为浏览
- Lab_OperStatus = "1"
- Call Sub_OperStatus("1")
- End Select
- '<<]
- '重 置 网 格
- Call Sub_AdjustGrid
- End Sub
- Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
- '屏蔽文本框有效性判断
- Valilock = True
- '屏蔽网格失去焦点产生的有效性判断
- Changelock = True
- Select Case Button.Key
- Case "ymsz" '页面设置
- Dyymctbl.Show 1
- Case "yl" '预 览
- If Fun_Drfrmyxxpd Then Call bbyl(True)
- Case "dy" '打 印
- If Fun_Drfrmyxxpd Then Call bbyl(False)
- Case "xz" '新 增
- Call Sub_AddBill
- Case "zh" '增 行
- Call zjlrfl
- Case "sh" '删 行
- Call Scdqfl
- Case "bc" '保 存
- If Fun_Drfrmyxxpd Then Call Sub_SaveBill
- Case "fh" '退 出
- Unload Me
- End Select
- '解 锁
- Valilock = False
- Changelock = False
- End Sub
- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '支持热键操作
- With Me.Tlb_Action
- Select Case KeyCode
- Case vbKeyF5
- If .Buttons("xz").Enabled = True And .Buttons("xz").Visible = True Then
- Call Tlb_Action_ButtonClick(.Buttons("xz"))
- End If
- Case vbKeyF6
- If .Buttons("bc").Enabled = True And .Buttons("bc").Visible = True Then
- Call Tlb_Action_ButtonClick(.Buttons("bc"))
- End If
- Case vbKeyF3
- If .Buttons("xg").Enabled = True And .Buttons("xg").Visible = True Then
- Call Tlb_Action_ButtonClick(.Buttons("xg"))
- End If
- Case 27
- If .Buttons("fq").Enabled = True And .Buttons("fq").Visible = True Then
- Call Tlb_Action_ButtonClick(.Buttons("fq"))
- End If
- End Select
- End With
- End Sub
- Private Sub FrmTlbState(int_FrmState As Integer)
- With Me.Tlb_Action
- Select Case int_FrmState
- Case 1 '增加
- .Buttons("ymsz").Visible = True
- .Buttons("yl").Visible = True
- .Buttons("dy").Visible = True
- .Buttons("xz").Visible = True
- .Buttons("xg").Visible = True
- .Buttons("sc").Visible = True
- .Buttons("zh").Visible = True
- .Buttons("sh").Visible = True
- .Buttons("bc").Visible = True
- .Buttons("fq").Visible = True
- .Buttons("cx").Visible = False
- .Buttons("first").Visible = False
- .Buttons("next").Visible = False
- .Buttons("last").Visible = False
- .Buttons("prev").Visible = False
- Case 2 '修改
- .Buttons("ymsz").Visible = True
- .Buttons("yl").Visible = True
- .Buttons("dy").Visible = True
- .Buttons("xz").Visible = False
- .Buttons("xg").Visible = True
- .Buttons("sc").Visible = True
- .Buttons("zh").Visible = True
- .Buttons("sh").Visible = True
- .Buttons("bc").Visible = True
- .Buttons("fq").Visible = True
- .Buttons("first").Visible = True
- .Buttons("next").Visible = True
- .Buttons("last").Visible = True
- .Buttons("prev").Visible = True
- .Buttons("bKey5").Visible = True
- Case 3 '审核
- .Buttons("ymsz").Visible = True
- .Buttons("yl").Visible = True
- .Buttons("dy").Visible = True
- .Buttons("bKey1").Visible = False
- .Buttons("bKey2").Visible = False
- .Buttons("xz").Visible = False
- .Buttons("xg").Visible = False
- .Buttons("sc").Visible = False
- .Buttons("zh").Visible = False
- .Buttons("sh").Visible = False
- .Buttons("bc").Visible = False
- .Buttons("fq").Visible = False
- .Buttons("Check").Visible = True
- .Buttons("Uncheck").Visible = True
- .Buttons("CheckAll").Visible = True
- .Buttons("UncheckAll").Visible = True
- .Buttons("sCheck").Visible = True
- .Buttons("first").Visible = True
- .Buttons("next").Visible = True
- .Buttons("last").Visible = True
- .Buttons("prev").Visible = True
- End Select
- End With
- End Sub
- Private Sub Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
- With Tlb_Action
- Select Case Str_Status
- Case "1" '初始化,放弃新增,放弃查询
- '工具条]
- .Buttons("ymsz").Enabled = True '设置
- .Buttons("dy").Enabled = True '打印
- .Buttons("yl").Enabled = True '预览
- .Buttons("xz").Enabled = True '新增
- .Buttons("xg").Enabled = False '修改
- .Buttons("sc").Enabled = False '删除
- .Buttons("zh").Enabled = False '增行
- .Buttons("sh").Enabled = False '删行
- .Buttons("bc").Enabled = False '保存
- .Buttons("fq").Enabled = False '放弃
- .Buttons("cx").Enabled = True '查询
- .Buttons("first").Enabled = True '首张
- .Buttons("prev").Enabled = True '上张
- .Buttons("next").Enabled = True '下张
- .Buttons("last").Enabled = True '末张
- Case "2" '新增单据
- '工具条
- .Buttons("ymsz").Enabled = False '设置
- .Buttons("dy").Enabled = False '打印
- .Buttons("yl").Enabled = False '预览
- .Buttons("xz").Enabled = False '新增
- .Buttons("xg").Enabled = False '修改
- .Buttons("sc").Enabled = False '删除
- .Buttons("zh").Enabled = True '增行
- .Buttons("sh").Enabled = True '删行
- .Buttons("bc").Enabled = True '保存
- .Buttons("fq").Enabled = True '放弃
- .Buttons("cx").Enabled = False '查询
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- '录入文本框
- Case "3" '修改
- '工具条
- .Buttons("ymsz").Enabled = False '设置
- .Buttons("dy").Enabled = False '打印
- .Buttons("yl").Enabled = False '预览
- .Buttons("xz").Enabled = False '新增
- .Buttons("xg").Enabled = False '修改
- .Buttons("sc").Enabled = False '删除
- .Buttons("zh").Enabled = True '增行
- .Buttons("sh").Enabled = True '删行
- .Buttons("bc").Enabled = True '保存
- .Buttons("fq").Enabled = True '放弃
- .Buttons("cx").Enabled = False '查询
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- Case "4" '查询单据)
- '工具条
- .Buttons("ymsz").Enabled = True '设置
- .Buttons("dy").Enabled = True '打印
- .Buttons("yl").Enabled = True '预览
- .Buttons("xz").Enabled = False '新增
- .Buttons("xg").Enabled = True '修改
- .Buttons("sc").Enabled = True '删除
- .Buttons("zh").Enabled = False '增行
- .Buttons("sh").Enabled = False '删行
- .Buttons("bc").Enabled = False '保存
- .Buttons("fq").Enabled = True '放弃
- .Buttons("cx").Enabled = True '查询
- If Cxdjgs > 1 Then
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = True '下张
- .Buttons("last").Enabled = True '末张
- Else
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- End If
- Case "5" '放弃修改
- '工具条
- .Buttons("ymsz").Enabled = True '设置
- .Buttons("dy").Enabled = True '打印
- .Buttons("yl").Enabled = True '预览
- .Buttons("xz").Enabled = True '新增
- .Buttons("xg").Enabled = True '修改
- .Buttons("sc").Enabled = True '删除
- .Buttons("zh").Enabled = False '增行
- .Buttons("sh").Enabled = False '删行
- .Buttons("bc").Enabled = False '保存
- .Buttons("fq").Enabled = False '放弃
- .Buttons("cx").Enabled = True '查询
- If Me.rs_PAutoID.State = 0 Then Exit Sub
- If Me.rs_PAutoID.RecordCount = 0 Then
- .Buttons("first").Enabled = True '首张
- .Buttons("prev").Enabled = True '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- Exit Sub
- End If
- If Me.rs_PAutoID.EOF = True Then
- .Buttons("first").Enabled = True '首张
- .Buttons("prev").Enabled = True '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- ElseIf Me.rs_PAutoID.BOF = True Then
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = True '下张
- .Buttons("last").Enabled = True '末张
- Else
- .Buttons("first").Enabled = True '首张
- .Buttons("prev").Enabled = True '上张
- .Buttons("next").Enabled = True '下张
- .Buttons("last").Enabled = True '末张
- End If
- Case "6" '显示列表单据
- '工具条
- .Buttons("ymsz").Enabled = False '设置
- .Buttons("dy").Enabled = False '打印
- .Buttons("yl").Enabled = False '预览
- .Buttons("xz").Enabled = False '新增
- .Buttons("xg").Enabled = False '修改
- .Buttons("sc").Enabled = False '删除
- .Buttons("zh").Enabled = False '增行
- .Buttons("sh").Enabled = False '删行
- .Buttons("bc").Enabled = False '保存
- .Buttons("fq").Enabled = False '放弃
- .Buttons("cx").Enabled = False '查询
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- '录入文本框
- WglrGrid.Enabled = True
- WglrGrid.Editable = False
- End Select
- End With
- End Sub
- Private Sub Wbkcl() '文本框录入之前处理(根据实际情况)
- Dim xswbrr As String
- With WglrGrid
- Zdlrqnr = Trim(.Text)
- xswbrr = Trim(.Text)
- If GridBoolean(.Col, 3) Then '列表框录入
- Else
- Wbkbhlock = True
- '====以下为用户自定义
- Ydtext.Text = xswbrr
- '====以上为用户自定义
- Wbkbhlock = False
- Ydtext.SelStart = Len(Ydtext.Text)
- End If
- End With
- End Sub
- Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) '录入数据字段有效性判断,同时进行字段录入事后处理
- Dim Str_JudgeText As String '临时有效性判断字段内容
- Dim Coljsq As Long '临时列计数器
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim Str_Temp As String
- Dim rs_Temp As New ADODB.Recordset
- pdzwx = False
- With WglrGrid
- '非录入状态有效性为合法
- If Yxxpdlock Or .Row < .FixedRows Then
- sjzdyxxpd = True
- Exit Function
- End If
- Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
- Select Case GridStr(Dqpdwgl, 1)
- '以下为自定义部分[
- Case "001"
- If Trim(Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) = "" Then Exit Function
- Str_Temp = "select * from CG_V_Material where MNumber ='" & Trim(Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) & "' and isPurchase =1"
- Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
- If rs_Temp.EOF Then
- Tsxx = "此物料编码不存在或不具备采购属性!"
- GoTo Lrcwcl
- End If
- Set rs_Temp = Nothing
- Str_Temp = "select * from CG_V_PlanBill where MNumber ='" & Trim(Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) & "' and PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory=''"
- Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
- If Not rs_Temp.EOF() Then
- .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(rs_Temp.Fields("MName"))
- .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(rs_Temp.Fields("Model"))
- .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(rs_Temp.Fields("PurUnitName"))
- Else
- Tsxx = "此拆分计划中不存在此物料编码或此物料编码已指定生产厂家!"
- GoTo Lrcwcl
- End If
- Case "005" '供应商
- If Not Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))) = "" Then
- str_Cmp = Trim(Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)))
- Str_Temp = "select * from Gy_Supplier where (SupplierCode ='" & str_Cmp & "' or SupplierName='" & str_Cmp & "') and StopFlag=0 "
- Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
- If rs_Temp.EOF() Then
- Tsxx = "此供应商不存在或已经停用!"
- GoTo Lrcwcl
- Else
- Me.WglrGrid.TextMatrix(Dqpdwgh, 1) = Trim(rs_Temp.Fields("SupplierCode"))
- Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(rs_Temp.Fields("SupplierName"))
- End If
- End If
- Case "006"
- If Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) = "" Then
- Exit Function
- End If
- If (Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz(GridStr(Dqpdwgl, 1), GridStr(), Szzls))))) And Trim(.TextMatrix(Dqpdwgh, Sydz(GridStr(Dqpdwgl, 1), GridStr(), Szzls))) <> "" Then
- Tsxx = "请输入数字!"
- GoTo Lrcwcl
- Else
- .TextMatrix(Dqpdwgh, Sydz(GridStr(Dqpdwgl, 1), GridStr(), Szzls)) = S2N(Trim(.TextMatrix(Dqpdwgh, Sydz(GridStr(Dqpdwgl, 1), GridStr(), Szzls))))
- If S2N(Trim(.TextMatrix(Dqpdwgh, Sydz(GridStr(Dqpdwgl, 1), GridStr(), Szzls)))) < 0 Then
- Tsxx = "数量不能小于零!"
- GoTo Lrcwcl
- End If
- End If
- Dim Num_Tmp As Double
- Dim Jsq_Tmp As Integer
- Num_Tmp = 0
- For Jsq_Tmp = 1 To Dqpdwgh
- If Trim(.TextMatrix(Jsq_Tmp, Sydz("001", GridStr(), Szzls))) = Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) Then
- Num_Tmp = Num_Tmp + S2N(Me.WglrGrid.TextMatrix(Jsq_Tmp, Sydz("006", GridStr(), Szzls)))
- End If
- Next Jsq_Tmp
- Dim i As Long
- For i = 0 To plan_material_num
- If Material_Str(i) = Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) Then
- Exit For
- End If
- Next i
- If Num_Tmp > Material_Num(i) Then
- Tsxx = "数量已经超过原计划数量!"
- GoTo Lrcwcl
- End If
- '以上为自定义部分]
- End Select
- '字段录入正确后为零字段清空
- Call Qkwlzd(Dqpdwgh, Dqpdwgl)
- sjzdyxxpd = True
- Yxxpdlock = True
- Exit Function
- End With
- Lrcwcl: '录入错误处理
- With WglrGrid
- Call Xtxxts(Tsxx, 0, 1)
- Changelock = True
- .Select Dqpdwgh, Dqpdwgl
- Changelock = False
- Call xswbk
- sjzdyxxpd = False
- Exit Function
- End With
- End Function
- Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean '录入数据行有效性判断,同时进行行处理
- Dim Lrywlz As Long
- Dim RecTemp As New ADODB.Recordset
- Dim Yxrow As Long
- With WglrGrid
- If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
- If .TextMatrix(Yxxpdh, 0) <> "*" Then
- Sjhzyxxpd = True
- Exit Function
- Else
- If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
- If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
- Changelock = True
- .RemoveItem Yxxpdh
- If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
- .AddItem ""
- .RowHeight(.Rows - 1) = Sjhgd
- End If
- Changelock = False
- Sjhzyxxpd = True
- Exit Function
- End If
- End If
- End If
- If Hyxxpdlock Then
- Sjhzyxxpd = True
- Exit Function
- End If
- '以下为自定义部分[
- '1.放置行有效性判断程序
- For jsqte = Qslz To .Cols - 1
- '字段不能为空
- If GridInt(jsqte, 5) = 1 Then
- If Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
- Tsxx = GridStr(jsqte, 2)
- Lrywlz = jsqte
- GoTo Lrcwcl
- Exit For
- End If
- End If
- '字段不能为零
- If GridInt(jsqte, 5) = 2 Then
- If S2N(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
- Tsxx = GridStr(jsqte, 2)
- Lrywlz = jsqte
- GoTo Lrcwcl
- Exit For
- End If
- End If
- Next jsqte
- '自定义判断(补丁)
- '2.放置行处理程序
- '以上为自定义部分]
- End With
- Sjhzyxxpd = True
- Hyxxpdlock = True
- Exit Function
- Lrcwcl: '录入错误处理
- With WglrGrid
- Call Xtxxts(Tsxx, 0, 1)
- Changelock = True
- .Select Yxxpdh, Lrywlz
- Changelock = False
- Call xswbk
- Sjhzyxxpd = False
- Exit Function
- End With
- End Function
- Private Sub Sub_AddBill() '新增一张单据
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim jsqte As Long '临时计数器
- '设置操作状态为新增
- Lab_OperStatus.Caption = "2"
- '设置工具条状态
- Call Sub_OperStatus("2")
- '重置网格
- With WglrGrid
- .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
- For jsqte = .FixedRows To .Rows - 1
- .RowHeight(jsqte) = Sjhgd
- Next jsqte
- .Clear 1
- Changelock = True
- .Select .FixedRows, Qslz
- Changelock = False
- End With
- '计算合计数据(清零)
- For jsqte = Qslz To WglrGrid.Cols - 1
- Call Sjhj(jsqte)
- Next jsqte
- '初始化默认数据
- '凭证类别得到焦点
- Me.WglrGrid.Enabled = True
- End Sub
- Private Sub Sub_ClearBill() '放弃清除
- Dim jsqte As Long
- '清除文本框内容
- TextChangeLock = True
- '清除网格内容
- With WglrGrid
- .Clear 1
- End With
- '初始化合计网格
- Call Cshhjwg
- TextChangeLock = False
- End Sub
- Private Function Sub_SaveBill() As Boolean '保 存 单 据
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim Recfind As New ADODB.Recordset '有效性判断动态集
- Dim Rowjsq As Long '网格行计数器
- Dim Coljsq As Long '网格列计数器
- Dim jsqte As Integer '临时计数器
- Dim Int_RowCount As Integer '有效数据行计数器
- Dim Bln_AssVali As Boolean '辅助核算错误标识
- Dim Lrywlz As Long '录入有误列值
- Dim Dbl_Jfhj As Double '借方合计
- Dim Dbl_Dfhj As Double '贷方合计
- Dim Int_Year As Integer '用户选择会计年度
- Dim Int_Period As Integer '用户选择会计期间
- Dim Int_VouchNo As Integer '单据号
- Dim i, j As Long
- Dim Str_Temp As String
- Dim Num_Total As Double '当前拆分的物料数量
- '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
- '[判断用户所选会计期间是否有效(非结帐月份),且制单日期必须和所选会计期间一致
- '下面将对所有有效数据行进行有效性判断
- Int_RowCount = 0
- With WglrGrid
- Str_Temp = ""
- For Rowjsq = .FixedRows To .Rows
- '带*号者为有效数据行
- If Trim(.TextMatrix(Rowjsq, 0)) <> "*" Then
- Exit For
- Else
- Int_RowCount = Int_RowCount + 1
- End If
- '1.首先进行为空或为零判断(Fixed)
- For Coljsq = Qslz To .Cols - 1
- If (GridInt(Coljsq, 5) = 1 And Len(Trim("" & .TextMatrix(Rowjsq, Coljsq))) = 0) Then
- If Not .ColHidden(Coljsq) Then
- Tsxx = GridStr(Coljsq, 2)
- Lrywlz = Coljsq
- GoTo Lrcwcl
- Exit For
- End If
- End If
- If GridInt(Coljsq, 5) = 2 Then
- If Not .ColHidden(Coljsq) Then
- If S2N(Trim("" & .TextMatrix(Rowjsq, Coljsq))) = 0 Then
- Tsxx = GridStr(Coljsq, 2)
- Lrywlz = Coljsq
- GoTo Lrcwcl
- Exit For
- End If
- End If
- End If
- Next Coljsq
- Next Rowjsq
- '分录行数不能为零
- If Int_RowCount = 0 Then
- Tsxx = "单据录入行数为零,不能存盘!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Function
- End If
- '记录拆分情况
- ReDim Preserve arrStr_MNum(0)
- arrStr_MNum(0) = Trim(.TextMatrix(.FixedRows, Sydz("001", GridStr(), Szzls)))
- ReDim Preserve arrDbl_Quan(0)
- arrDbl_Quan(0) = .TextMatrix(.FixedRows, Sydz("006", GridStr(), Szzls))
- For i = .FixedRows + 1 To .Rows - 1
- If Trim(.TextMatrix(i, 0)) = "*" Then
- For j = LBound(arrStr_MNum, 1) To UBound(arrStr_MNum, 1)
- If Trim(.TextMatrix(i, Sydz("001", GridStr(), Szzls))) = Trim(arrStr_MNum(j)) Then
- arrDbl_Quan(j) = arrDbl_Quan(j) + S2N(.TextMatrix(i, Sydz("006", GridStr(), Szzls)))
- Exit For
- End If
- Next j
- If j > UBound(arrStr_MNum, 1) Then
- ReDim Preserve arrStr_MNum(UBound(arrStr_MNum, 1) + 1)
- arrStr_MNum(UBound(arrStr_MNum, 1)) = Trim(.TextMatrix(i, Sydz("001", GridStr(), Szzls)))
- ReDim Preserve arrDbl_Quan(UBound(arrDbl_Quan, 1) + 1)
- arrDbl_Quan(UBound(arrDbl_Quan, 1)) = S2N(.TextMatrix(i, Sydz("006", GridStr(), Szzls)))
- End If
- End If
- Next i
- End With '网格
- Str_Temp = "select * from Cg_PurPlanMain where PurPlanMainID='" & Me.dbl_RecordAutoCode & "'"
- Set rs_From(0) = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
- Str_Temp = "select MNumber,Sum(Quantity) as SumQuantity from Cg_V_PlanBill where PurPlanMainID='" & Me.dbl_RecordAutoCode & "' and ProcFactory='' Group By MNumber"
- Set rs_From(1) = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
- With rs_From(1)
- ReDim arrStr_LeftMNum(.RecordCount - 1)
- ReDim arrDbl_LeftQuan(.RecordCount - 1)
- j = LBound(arrStr_LeftMNum, 1)
- Do While Not .EOF()
- arrStr_LeftMNum(j) = Trim(.Fields("MNumber"))
- arrDbl_LeftQuan(j) = .Fields("SumQuantity")
- For i = LBound(arrStr_MNum, 1) To UBound(arrStr_MNum, 1)
- If arrStr_LeftMNum(j) = arrStr_MNum(i) Then
- arrDbl_LeftQuan(j) = arrDbl_LeftQuan(j) - arrDbl_Quan(i)
- If arrDbl_LeftQuan(j) < 0 Then
- Call Xtxxts(arrStr_MNum(i) & "数量超出计划范围", 0, 4)
- Exit Function
- End If
- Exit For
- End If
- Next i
- .MoveNext
- j = j + 1
- Loop
- End With
- If FnBln_SaveData(S2N(Lab_OperStatus)) Then
- Sub_SaveBill = True
- Tsxx = "单据存盘完毕! "
- Call Xtxxts(Tsxx, 0, 4)
- bln_IsChanged = True
- Call Sub_OperStatus("1")
- Xtfhcs = "1"
- WglrGrid.Enabled = False
- Exit Function
- Else
- GoTo Swcwcl
- End If
- Exit Function
- Swcwcl:
- Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Function
- Lrcwcl: '录入错误处理
- With WglrGrid
- Call Xtxxts("(第 " + Trim(Str(Int_RowCount)) + " 条会计分录)-" + Tsxx, 0, 1)
- Changelock = True
- .Select Rowjsq, Lrywlz
- WglrGrid.SetFocus
- Changelock = False
- Exit Function
- End With
- End Function
- Private Sub Chk_DeleteMess_Click() '删行是否提示(点击)
- If Chk_DeleteMess.Value = 1 Then
- Shsfts = True
- Else
- Shsfts = False
- End If
- End Sub
- Private Function Fun_AllowEdit() As Boolean '判断当前单据是否允许编辑或删除
- Fun_AllowEdit = True
- End Function
- Private Sub Sub_AdjustGrid()
- '调 整 网 格
- With WglrGrid
- '加 1 保持一行录入行
- If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
- .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
- For jsqte = .FixedRows To .Rows - 1
- .RowHeight(jsqte) = Sjhgd
- Next jsqte
- End If
- '判断是否有辅助行和录入行,如没有则加行
- Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
- .AddItem ""
- .RowHeight(.Rows - 1) = Sjhgd
- Loop
- End With
- End Sub
- Private Sub Lrzdbz() '录入字段帮助
- If Not Ydcommand.Visible Then
- Exit Sub
- End If
- With WglrGrid
- Valilock = True
- '处理通用部分
- Changelock = True '调入另外窗体必须加锁
- Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
- Changelock = False
- If Len(Xtfhcs) <> 0 Then
- If GridInt(.Col, 7) = 0 Then
- Ydtext.Text = Xtfhcs
- Else
- Ydtext.Text = Xtfhcsfz
- End If
- End If
- Valilock = False
- If Ydtext.Visible Then
- Ydtext.SetFocus
- End If
- End With
- End Sub
- Private Sub Cshhjwg() '初始化合计网格(*对合计网格来说,录入网格为容器)
- With HjGrid
- '是否显示合计网格
- If Not Sfxshjwg Then
- .Visible = False
- Exit Sub
- Else
- .Visible = True
- End If
- '设置网格相关属性
- .Enabled = False
- .Appearance = flexFlat
- .BorderStyle = flexBorderNone
- .ScrollBars = flexScrollBarNone
- .Width = WglrGrid.Width
- .FixedRows = 0
- .Rows = 1
- .Cols = WglrGrid.Cols
- .LeftCol = WglrGrid.LeftCol
- .TextMatrix(0, Qslz) = "合 计"
- For jsqte = 0 To WglrGrid.Cols - 1
- .ColHidden(jsqte) = WglrGrid.ColHidden(jsqte)
- .ColWidth(jsqte) = WglrGrid.ColWidth(jsqte)
- .ColAlignment(jsqte) = WglrGrid.ColAlignment(jsqte)
- .ColFormat(jsqte) = WglrGrid.ColFormat(jsqte)
- Next jsqte
- .ColAlignment(Qslz) = flexAlignCenterTop
- For jsqte = .FixedRows To .Rows - 1
- .RowHeight(jsqte) = .Height / .Rows
- Next jsqte
- '程序自动调整网格高度(自动设置为网格剩余高度+辅助项网格行数(默认为1)*数据行高度)、并设置其位置信息
- .Height = Fzxwghs * Sjhgd + ((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) Mod Sjhgd)
- .RowHeight(0) = .Height
- .Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
- End With
- End Sub
- Private Sub Form_Resize() '窗体大小发生变化时,重新显示文本框
- Call Cxxswbk
- End Sub
- Private Function Fun_Drfrmyxxpd() As Boolean '调入其它窗体或功能产生的有效性判断(包括数据回写)
- Fun_Drfrmyxxpd = True
- With WglrGrid
- '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
- If Ydtext.Visible Or YdCombo.Visible Then
- Call Lrsjhx
- If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
- Fun_Drfrmyxxpd = False
- Exit Function
- End If
- End If
- '进行行有效性判断
- If Not Sjhzyxxpd(.Row) Then
- Fun_Drfrmyxxpd = False
- Exit Function
- End If
- End With
- End Function
- Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long) '调整列宽
- If HjGrid.Visible Then
- With HjGrid
- .ColWidth(Col) = WglrGrid.ColWidth(Col)
- End With
- End If
- End Sub
- Private Sub WglrGrid_EnterCell() '显示当前数据行相关信息
- With WglrGrid
- If .Row >= .FixedRows Then
- '[>>
- '此处可以填写显示与此网格行相关信息
- '<<]
- End If
- End With
- End Sub
- Private Sub WglrGrid_GotFocus() '网格得到焦点
- '网格得到焦点,如果当前选择行为非数据行
- '则调整当前焦点至有效数据行
- With WglrGrid
- If .Row < .FixedRows And .Rows > .FixedRows Then
- Changelock = True
- .Select .FixedRows, .Col
- Changelock = False
- End If
- If .Col < Qslz Then
- Changelock = True
- .Select .Row, Qslz
- Changelock = False
- End If
- End With
- End Sub
- Private Sub WglrGrid_LostFocus() '录入网格失去焦点
- '用以屏蔽调用其它窗体时发生网格失去焦点事件
- If Changelock Then
- Exit Sub
- End If
- '引发网格RowcolChange事件
- With WglrGrid
- If Not (Ydtext.Visible Or YdCombo.Visible) Then
- .Select 0, 0
- End If
- End With
- End Sub
- Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long) '限制用户在录入过程中滚动鼠标
- If Gdtlock Then
- Exit Sub
- End If
- With WglrGrid
- If Ydtext.Visible Or YdCombo.Visible Then
- Gdtlock = True
- .TopRow = Dqtoprow
- .LeftCol = Dqleftcol
- Gdtlock = False
- Exit Sub
- End If
- HjGrid.LeftCol = .LeftCol
- End With
- End Sub
- Private Sub WglrGrid_LeaveCell() '离开单元格
- If Changelock Then
- Exit Sub
- End If
- '记录刚刚离开网格单元的行列值
- Dqlkwgh = WglrGrid.Row
- Dqlkwgl = WglrGrid.Col
- '判断是否需要录入数据回写
- If Not (Ydtext.Visible Or YdCombo.Visible) Then
- Exit Sub
- End If
- Call Lrsjhx
- End Sub
- Private Sub WglrGrid_RowColChange() '网格录入行列发生变化时,进行有效性判断
- Valilock = True '屏蔽文本框失去焦点进行有效性判断
- With WglrGrid
- If Changelock Then
- Exit Sub
- End If
- If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
- Exit Sub
- End If
- If .Row <> Dqlkwgh Then
- If Not Sjhzyxxpd(Dqlkwgh) Then
- Exit Sub
- End If
- End If
- End With
- Call fhyxh
- Call Xldql
- End Sub
- Private Sub WglrGrid_DblClick() '鼠标双击网格显示文本框
- With WglrGrid
- Call xswbk
- End With
- End Sub
- Private Sub Ycwbk() '隐藏文本框,帮助按钮,列表组合框
- Valilock = True
- Ydtext.Visible = False
- YdCombo.Visible = False
- Ydcommand.Visible = False
- End Sub
- Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer) '列表框移动
- With WglrGrid
- Select Case KeyCode
- Case vbKeyEscape 'ESC 键放弃录入
- Valilock = True
- .SetFocus
- Call Ycwbk
- Valilock = False
- Case vbKeyReturn '回 车 键 =13
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- Rowjsq = .Row
- Coljsq = .Col + 1
- If Coljsq > .Cols - 1 Then
- If Rowjsq < .Rows - 1 Then
- Rowjsq = Rowjsq + 1
- End If
- Coljsq = Qslz
- End If
- Do While Rowjsq <= .Rows - 1
- If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
- Coljsq = Coljsq + 1
- If Coljsq > .Cols - 1 Then
- Rowjsq = Rowjsq + 1
- Coljsq = Qslz
- End If
- Else
- Exit Do
- End If
- Loop
- .Select Rowjsq, Coljsq
- Case vbKeyLeft '左 箭 头 =37
- If .Col - 1 = Qslz Then
- If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
- GoTo jzzx
- End If
- End If
- If .Col > Qslz Then
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- Coljsq = .Col - 1
- Do While Coljsq > Qslz
- If Coljsq - 1 = Qslz Then
- If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
- GoTo jzzx
- End If
- End If
- If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
- Coljsq = Coljsq - 1
- Else
- Exit Do
- End If
- Loop
- .Select .Row, Coljsq
- End If
- Case vbKeyRight '右 箭 头 =39
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- Rowjsq = .Row
- Coljsq = .Col + 1
- If Coljsq > .Cols - 1 Then
- If Rowjsq < .Rows - 1 Then
- Rowjsq = Rowjsq + 1
- End If
- Coljsq = Qslz
- End If
- Do While Rowjsq <= .Rows - 1
- If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
- Coljsq = Coljsq + 1
- If Coljsq > .Cols - 1 Then
- Rowjsq = Rowjsq + 1
- Coljsq = Qslz
- End If
- Else
- Exit Do
- End If
- Loop
- .Select Rowjsq, Coljsq
- Case Else
- End Select
- jzzx:
- End With
- End Sub
- Private Sub YdCombo_LostFocus()
- With WglrGrid '因为选中网格会先发生Rowcolchange事件置Valiock
- If Not Valilock Then '为TRUE
- Call Lrsjhx
- If Not Sjhzyxxpd(Dqlrwgh) Then
- Exit Sub
- End If
- End If
- End With
- End Sub
- Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
- Call Lrzdbz
- End Sub
- Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
- Dim Rowjsq As Long, Coljsq As Long
- With WglrGrid
- Select Case KeyCode
- Case vbKeyF2
- Call Lrzdbz
- Case vbKeyEscape 'ESC 键放弃录入
- Valilock = True
- Call Ycwbk
- .SetFocus
- Case vbKeyReturn '回 车 键 =13
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- Rowjsq = .Row
- Coljsq = .Col + 1
- If Coljsq > .Cols - 1 Then
- If Rowjsq < .Rows - 1 Then
- Rowjsq = Rowjsq + 1
- End If
- Coljsq = Qslz
- End If
- Do While Rowjsq <= .Rows - 1
- If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
- Coljsq = Coljsq + 1
- If Coljsq > .Cols - 1 Then
- Rowjsq = Rowjsq + 1
- Coljsq = Qslz
- End If
- Else
- Exit Do
- End If
- Loop
- If Rowjsq <= .Rows - 1 Then
- .Select Rowjsq, Coljsq
- End If
- Case vbKeyUp '上 箭 头 =38
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- If .Row > .FixedRows Then
- .Row = .Row - 1
- End If
- Case vbKeyDown '下 箭 头 =40
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- If .Row < .Rows - 1 Then
- .Row = .Row + 1
- End If
- Case vbKeyLeft '左 箭 头 =37
- If .Col - 1 = Qslz Then
- If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
- GoTo jzzx
- End If
- End If
- If Ydtext.SelStart = 0 And .Col > Qslz Then
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- Coljsq = .Col - 1
- Do While Coljsq > Qslz
- If Coljsq - 1 = Qslz Then
- If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
- GoTo jzzx
- End If
- End If
- If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
- Coljsq = Coljsq - 1
- Else
- Exit Do
- End If
- Loop
- .Select .Row, Coljsq
- End If
- jzzx:
- Case vbKeyRight '右 箭 头 =39
- wblong = Len(Ydtext.Text)
- If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
- KeyCode = 0
- .SetFocus
- Call Lrsjhx
- Rowjsq = .Row
- Coljsq = .Col + 1
- If Coljsq > .Cols - 1 Then
- If Rowjsq < .Rows - 1 Then
- Rowjsq = Rowjsq + 1
- End If
- Coljsq = Qslz
- End If
- Do While Rowjsq <= .Rows - 1
- If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
- Coljsq = Coljsq + 1
- If Coljsq > .Cols - 1 Then
- Rowjsq = Rowjsq + 1
- Coljsq = Qslz
- End If
- Else
- Exit Do
- End If
- Loop
- .Select Rowjsq, Coljsq
- End If
- Case Else
- End Select
- End With
- End Sub
- Private Sub ydtext_KeyPress(KeyAscii As Integer) '录入字符事中控制
- Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
- If KeyAscii <> 0 Then
- Call Xyxhbz(Dqlrwgh)
- End If
- End Sub
- Private Sub ydtext_Change() '录入事中变化处理
- '防止程序改变但不进行处理
- If Wbkbhlock Then
- Exit Sub
- End If
- With WglrGrid
- '限制字段录入长度
- Wbkbhlock = True
- Call TextChangeLimit(Ydtext, GridInt(.Col, 1)) '去掉无效字符
- Select Case GridInt(.Col, 1)
- Case 8, 11 '金额型
- Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
- Case 9, 12 '数量型
- Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
- Case 10 '单价型
- Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
- Case Else '其他类型
- If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
- Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
- End If
- End Select
- Wbkbhlock = False
- End With
- End Sub
- Private Sub ydtext_LostFocus() '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
- With WglrGrid
- If Not Valilock Then
- Call Lrsjhx
- If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
- Exit Sub
- End If
- If Not Sjhzyxxpd(Dqlrwgh) Then
- Exit Sub
- End If
- End If
- End With
- End Sub
- Private Sub xswbk() '在当前选中单元显示文本框,列表框,帮助按钮(通用)
- Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
- '当某种条件成立时禁止文本框激活使单据处于录入状态
- If Not Fun_AllowInput Then
- Exit Sub
- End If
- '显示文本框前返回有效行列（解决滚动条问题）
- Call Xldqh
- Call Xldql
- '隐藏文本框,帮助按钮,列表组合框
- Call Ycwbk
- With WglrGrid
- Dqlrwgh = .Row
- Dqlrwgl = .Col
- If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
- Exit Sub
- End If
- Wbkpy = 30
- Wbkpy1 = 15
- On Error Resume Next
- If GridBoolean(.Col, 3) Then
- YdCombo.Left = .CellLeft + .Left + Wbkpy
- YdCombo.Top = .CellTop + .Top + Wbkpy
- YdCombo.Width = .CellWidth - Wbkpy1
- Call Wbkcl
- YdCombo.Visible = True
- YdCombo.SetFocus
- Ydcommand.Visible = False
- Ydtext.Visible = False
- Else
- If GridBoolean(.Col, 2) Then
- Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
- Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
- Ydcommand.Visible = True
- Else
- Ydcommand.Visible = False
- End If
- Ydtext.Left = .CellLeft + .Left + Wbkpy
- Ydtext.Top = .CellTop + .Top + Wbkpy
- If Ydcommand.Visible Then
- If Sfblbzkd Then
- Ydtext.Width = .CellWidth - Ydcommand.Width
- Else
- Ydtext.Width = .CellWidth - Wbkpy1
- End If
- Else
- Ydtext.Width = .CellWidth - Wbkpy1
- End If
- Ydtext.Height = .CellHeight - Wbkpy1
- If GridInt(.Col, 2) <> 0 Then
- Ydtext.MaxLength = GridInt(.Col, 2)
- Else
- Ydtext.MaxLength = 3000
- End If
- Call Wbkcl
- Ydtext.Visible = True
- Ydtext.SetFocus
- End If
- Dqtoprow = .TopRow
- Dqleftcol = .LeftCol
- '重置锁值
- Valilock = False
- Wbkbhlock = False
- End With
- End Sub
- Private Function Fun_AllowInput() As Boolean '当某种条件成立时禁止文本框激活使单据处于录入状态
- '如果单据操作状态为浏览状态则不能显示录入载体(通用)
- If Trim(Lab_OperStatus.Caption) = "1" Then
- Exit Function
- End If
- '[>>
- '此处可以填写禁止文本框激活使单据处于录入状态的理由
- '<<]
- Fun_AllowInput = True
- End Function
- Private Sub Cxxswbk() 'Formresize中重新显示文本框,列表框,帮助按钮(通用)
- Dim Wbkpy As Integer, Wbkpy1 As Integer
- Wbkpy = 30
- Wbkpy1 = 15
- With WglrGrid
- If YdCombo.Visible Then
- YdCombo.Left = .CellLeft + .Left + Wbkpy
- YdCombo.Top = .CellTop + .Top + Wbkpy
- YdCombo.Width = .CellWidth - Wbkpy1
- End If
- If Ydcommand.Visible Then
- Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
- Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
- End If
- If Ydtext.Visible Then
- If Ydcommand.Visible Then
- If Sfblbzkd Then
- Ydtext.Width = .CellWidth - Ydcommand.Width
- Else
- Ydtext.Width = .CellWidth - Wbkpy1
- End If
- Else
- Ydtext.Width = .CellWidth - Wbkpy1
- End If
- Ydtext.Left = .CellLeft + .Left + Wbkpy
- Ydtext.Top = .CellTop + .Top + Wbkpy
- Ydtext.Height = .CellHeight - Wbkpy1
- End If
- End With
- End Sub
- Private Sub Lrsjhx() '文本框录入数据回写
- With WglrGrid
- If YdCombo.Visible Then
- .Text = Trim(YdCombo.Text)
- End If
- If Ydtext.Visible Then
- .Text = Trim(Ydtext.Text)
- End If
- '(如果字段录入内容发生变化,则打开有效性判断锁)
- If Zdlrqnr <> Trim(.Text) Then
- Yxxpdlock = False
- Hyxxpdlock = False
- End If
- '如果字段录入内容不为空则写数据行有效性标志
- If Len(Trim(.Text)) <> 0 Then
- Call Xyxhbz(.Row)
- End If
- '隐藏文本框,帮助按钮,列表组合框
- Call Ycwbk
- End With
- End Sub
- Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer) '网格录入增行，删行快捷键
- '如果单据操作状态为浏览状态则不能显示录入载体
- If Trim(Lab_OperStatus.Caption) = "1" Then
- Exit Sub
- End If
- Select Case KeyCode
- Case vbKeyF2 '按F2键参照
- Call xswbk
- Call Lrzdbz
- Case vbKeyDelete '删行
- Call Scdqfl
- Case vbKeyInsert '增行
- Call zjlrfl
- End Select
- End Sub
- Private Sub WglrGrid_KeyPress(KeyAscii As Integer) '网格接受键盘录入
- '当某种条件成立时禁止文本框激活使单据处于录入状态
- If Not Fun_AllowInput Then
- Exit Sub
- End If
- With WglrGrid
- '屏 蔽 回 车 键
- If KeyAscii = vbKeyReturn Then
- KeyAscii = 0
- Rowjsq = .Row
- Coljsq = .Col + 1
- If Coljsq > .Cols - 1 Then
- If Rowjsq < .Rows - 1 Then
- Rowjsq = Rowjsq + 1
- End If
- Coljsq = Qslz
- End If
- Do While Rowjsq <= .Rows - 1
- If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
- Coljsq = Coljsq + 1
- If Coljsq > .Cols - 1 Then
- Rowjsq = Rowjsq + 1
- Coljsq = Qslz
- End If
- Else
- Exit Do
- End If
- Loop
- If Rowjsq <= .Rows - 1 Then
- .Select Rowjsq, Coljsq
- End If
- Exit Sub
- End If
- '接受用户录入
- Select Case KeyAscii
- Case 0 To 32 '用户输入KeyAscii为0-32的键 如空格
- '显示录入载体
- Call xswbk
- Case Else
- '防止非编辑字段SendKeys()出现死循环
- If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
- Exit Sub
- End If
- '如果此字段为列表框录入则调入相应列表框
- If GridBoolean(.Col, 3) Then
- '列表框录入
- Call xswbk
- Else
- Ydtext.Text = ""
- '录入限制
- Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
- If KeyAscii = 0 Then
- Exit Sub
- End If
- '如果录入字符有效则写有效行数据标志
- Call Xyxhbz(.Row)
- Call xswbk
- Ydtext.Text = ""
- Valilock = True
- SendKeys Chr(KeyAscii), True
- DoEvents
- Valilock = False
- End If
- End Select
- End With
- End Sub
- Private Sub zjlrfl() '增加录入分录
- With WglrGrid
- If Not (Ydtext.Visible Or YdCombo.Visible) Then
- If Not Fun_Drfrmyxxpd Then
- Exit Sub
- End If
- Else
- Exit Sub
- End If
- If .Row < .FixedRows Then
- Exit Sub
- End If
- .AddItem "", .Row
- .RowHeight(.Row) = Sjhgd
- If .Row <> .Rows - 1 Then
- If .TextMatrix(.Row + 1, 0) = "*" Then
- .TextMatrix(.Row, 0) = "*"
- Else
- .RemoveItem .Rows - 1
- End If
- End If
- Call Xldqh
- Call Xldql
- Hyxxpdlock = False
- End With
- End Sub
- Private Sub Scdqfl() '删除当前分录
- Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
- With WglrGrid
- Scqwghz = .Row
- Scqwglz = .Col
- If .TextMatrix(.Row, 0) = "*" Then
- '判断是否为录入状态
- If Ydtext.Visible Or YdCombo.Visible Then
- Sflrzt = True
- Validate = True
- Call Lrsjhx
- Validate = False
- End If
- Call Xldqh
- Changelock = True
- .Select .Row, 0
- Changelock = False
- If Shsfts Then
- .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
- Tsxx = "请确认是否删除当前记录?"
- yhAnswer = Xtxxts(Tsxx, 2, 2)
- If yhAnswer = 2 Then
- .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
- Changelock = True
- .Select Scqwghz, Scqwglz
- Changelock = False
- '如为录入状态,则恢复录入
- If Sflrzt Then
- Call xswbk
- End If
- Exit Sub
- End If
- End If
- .RemoveItem .Row
- If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
- .AddItem ""
- .RowHeight(.Rows - 1) = Sjhgd
- End If
- Changelock = True
- .Select .Row, Scqwglz
- Changelock = False
- '重新计算合计数据
- For Hjlzte = Qslz To .Cols - 1
- Call Sjhj(Hjlzte)
- Next Hjlzte
- End If
- End With
- End Sub
- Private Sub Sjhj(Hjwgl As Long) '网格列数据合计
- Dim Hjjg As Double
- If Not GridBoolean(Hjwgl, 4) Then
- Exit Sub
- End If
- With WglrGrid
- Hjjg = 0
- For jsqte = .FixedRows To .Rows - 1
- If .TextMatrix(jsqte, 0) = "*" Then
- Hjjg = Hjjg + S2N(.TextMatrix(jsqte, Hjwgl))
- End If
- Next jsqte
- If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
- HjGrid.TextMatrix(0, Hjwgl) = ""
- Else
- HjGrid.TextMatrix(0, Hjwgl) = Hjjg
- End If
- End With
- End Sub
- Private Sub Qkwlzd(sjh As Long, Sjl As Long) '清空为零字段
- If Not GridBoolean(Sjl, 5) Then
- Exit Sub
- End If
- With WglrGrid
- If S2N(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
- .TextMatrix(sjh, Sjl) = ""
- End If
- End With
- End Sub
- Private Sub fhyxh() '返回录入数据有效行,同时让得到焦点网格可见
- With WglrGrid
- If .Row >= .FixedRows Then
- If .TextMatrix(.Row, 0) <> "*" Then
- For Rowjsq = .FixedRows To .Rows - 1
- If .TextMatrix(Rowjsq, 0) <> "*" Then
- Exit For
- End If
- Next Rowjsq
- If Rowjsq <= .Rows - 1 Then
- Changelock = True
- .Select Rowjsq, .Col
- Changelock = False
- Else
- Changelock = True
- .Select .Rows - 1, .Col
- Changelock = False
- End If
- End If
- Call Xldqh
- End If
- End With
- End Sub
- Private Sub Xldqh() '显露当前行
- Dim Toprowte As Long
- With WglrGrid
- Toprowte = 0
- Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
- Toprowte = .TopRow
- .TopRow = .TopRow + 1
- Loop
- Toprowte = 0
- Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
- Toprowte = .TopRow
- If .TopRow > 1 Then
- .TopRow = .TopRow - 1
- End If
- Loop
- End With
- End Sub
- Private Sub Xldql() '显露当前列
- Dim Leftcolte As Long
- With WglrGrid
- If .Col >= Qslz And .Col >= .FixedCols Then
- If .LeftCol > .Col Then
- .LeftCol = .Col
- End If
- Leftcolte = 0
- Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
- Leftcolte = .LeftCol
- .LeftCol = .LeftCol + 1
- Loop
- End If
- End With
- End Sub
- Private Function pdhwk(sjh As Long) '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
- With WglrGrid
- For Coljsq = Qslz To .Cols - 1
- If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
- pdhwk = False
- Exit Function
- End If
- Next Coljsq
- pdhwk = True
- End With
- End Function
- Private Sub Xyxhbz(sjh As Long) '写行有效性标志,并判断是否增行
- With WglrGrid
- If .TextMatrix(sjh, 0) = "*" Then
- Exit Sub
- End If
- .TextMatrix(sjh, 0) = "*"
- If sjh >= .Rows - Fzxwghs - 1 Then
- .AddItem ""
- .RowHeight(.Rows - 1) = Sjhgd
- End If
- End With
- End Sub
- '*****************************以下为文本框录入处理程序(固定不变部分)*******************************'
- Private Sub Wbklrwbcl(Index As Integer) '文本框录入事后处理程序
- '以下为依据实际情况自定义部分[
- '在此填写文本框录入事后处理程序
- ']以上为依据实际情况自定义部分
- End Sub
- Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '点击按钮
- End Sub
- Private Sub TextShow(Index As Integer) '文本框得到焦点,显示相应信息
- '如果文本框有帮助,则显示帮助按钮
- If Textboolean(Index, 1) Then
- Ydcommand1.Visible = True
- Ydcommand1.Tag = Index
- Else
- Ydcommand1.Tag = ""
- Ydcommand1.Visible = False
- End If
- '[>>
- '可在此处定义其他处理动作
- '<<]
- End Sub
- Private Sub bbyl(bbylte As Boolean) '打印预览(通用)
- Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
- Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
- Bbxbtgs = 1 '报 表 小 标 题 行 数
- Bbbwhgs = 1 '报 表 表 尾 行 数
- ReDim Bbxbt(1 To Bbxbtgs)
- ReDim bbxbtzzxs(1 To Bbxbtgs)
- If Bbbwhgs <> 0 Then
- ReDim Bbbwh(1 To Bbbwhgs)
- ReDim Bbbwhzzxs(1 To Bbbwhgs)
- End If
- Bbzbt = ReportTitle
- bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
- Call Scyxsjb(WglrGrid) '生成报表数据
- Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
- If Not bbylte Then
- Unload DY_Tybbyldy
- End If
- End Sub
- Public Property Get PFrmTlbOprState() As Variant
- PFrmTlbOprState = int_FrmState
- End Property
- Public Property Let PFrmTlbOprState(ByVal vNewValue As Variant)
- int_FrmState = vNewValue
- End Property
