资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:171k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
- Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
- Begin VB.Form Cg_InvoiceBill
- BackColor = &H00E9F4FA&
- BorderStyle = 1 'Fixed Single
- Caption = "单据处理"
- ClientHeight = 6120
- ClientLeft = 675
- ClientTop = 720
- ClientWidth = 11010
- Icon = "采购系统_发票录入.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form4"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 6120
- ScaleWidth = 11010
- StartUpPosition = 1 '所有者中心
- Begin VB.CheckBox Chk_Xf
- BackColor = &H00E9F4FA&
- Caption = "现付"
- Enabled = 0 'False
- Height = 255
- Left = 7500
- TabIndex = 15
- Top = 1140
- Width = 1485
- End
- Begin VB.TextBox LrText
- ForeColor = &H00000000&
- Height = 300
- Index = 0
- Left = 1020
- TabIndex = 0
- Text = "0"
- Top = 1500
- Width = 1650
- End
- Begin MSComctlLib.Toolbar Tlb_Action
- Align = 1 'Align Top
- Height = 570
- Left = 0
- TabIndex = 5
- Top = 0
- Width = 11010
- _ExtentX = 19420
- _ExtentY = 1005
- ButtonWidth = 820
- ButtonHeight = 953
- AllowCustomize = 0 'False
- Wrappable = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 23
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "打印"
- Key = "dy"
- Object.ToolTipText = "打印当前单据或Ctrl+P"
- ImageKey = "dy"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "预览"
- Key = "yl"
- ImageKey = "yl"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "fgh0"
- Style = 3
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "新增"
- Key = "xz"
- Object.ToolTipText = "新增加一张单据或F5"
- ImageKey = "xz"
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "修改"
- Key = "xg"
- Object.ToolTipText = "修改当前单据或F3"
- ImageKey = "xg"
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "删除"
- Key = "sc"
- Object.ToolTipText = "删除当前单据"
- ImageKey = "sc"
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "fgh1"
- Style = 3
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "增行"
- Key = "zh"
- Object.ToolTipText = "插入一行或Insert"
- ImageKey = "zh"
- EndProperty
- BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "删行"
- Key = "sh"
- Object.ToolTipText = "删除当前记录行或Delete"
- ImageKey = "sh"
- EndProperty
- BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "fgh2"
- Style = 3
- EndProperty
- BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "保存"
- Key = "bc"
- Object.ToolTipText = "保存单据或F6"
- ImageKey = "bc"
- EndProperty
- BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "放弃"
- Key = "fq"
- Object.ToolTipText = "放弃此次操作"
- ImageKey = "fq"
- EndProperty
- BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "fgh3"
- Style = 3
- EndProperty
- BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "审核"
- Key = "shsh"
- ImageKey = "check"
- EndProperty
- BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "弃审"
- Key = "shqs"
- ImageKey = "qs"
- EndProperty
- BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "fgh4"
- Style = 3
- EndProperty
- BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "首张"
- Key = "first"
- ImageKey = "first"
- EndProperty
- BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "上张"
- Key = "prev"
- ImageKey = "prev"
- EndProperty
- BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "下张"
- Key = "next"
- ImageKey = "next"
- EndProperty
- BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "末张"
- Key = "last"
- ImageKey = "last"
- EndProperty
- BeginProperty Button21 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "fgh5"
- Style = 3
- EndProperty
- BeginProperty Button22 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "帮助"
- Key = "bz"
- ImageKey = "bz"
- EndProperty
- BeginProperty Button23 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "退出"
- Key = "fh"
- ImageKey = "tc"
- EndProperty
- EndProperty
- BorderStyle = 1
- End
- Begin VB.CommandButton Ydcommand
- Height = 300
- Left = 10680
- Picture = "采购系统_发票录入.frx":1042
- Style = 1 'Graphical
- TabIndex = 4
- Top = 990
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox Ydtext
- BackColor = &H80000018&
- BorderStyle = 0 'None
- Height = 330
- Left = 7710
- MultiLine = -1 'True
- TabIndex = 2
- Top = 960
- Visible = 0 'False
- Width = 1185
- End
- Begin VB.Timer Timer1
- Interval = 1
- Left = 9690
- Top = 150
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Left = 10680
- Picture = "采购系统_发票录入.frx":13CC
- Style = 1 'Graphical
- TabIndex = 9
- Top = 600
- Visible = 0 'False
- Width = 300
- End
- Begin VB.ComboBox YdCombo
- Height = 300
- Left = 9000
- Style = 2 'Dropdown List
- TabIndex = 3
- Top = 960
- Visible = 0 'False
- Width = 1155
- End
- Begin MSComctlLib.ImageList ImageList1
- Left = 10410
- Top = 1350
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 37
- 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 = "xg"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":25BE
- Key = "zh"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":2958
- Key = "sh"
- EndProperty
- BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":2CF2
- Key = "bc"
- EndProperty
- BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":308C
- Key = "fq"
- EndProperty
- BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":3426
- Key = "bz"
- EndProperty
- BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":37C0
- Key = "tc"
- EndProperty
- BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":3B5A
- Key = "bcgs"
- EndProperty
- BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":3EF4
- Key = "mrlk"
- EndProperty
- BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":428E
- Key = "xsxm"
- EndProperty
- BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":4628
- Key = "first"
- EndProperty
- BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":49C2
- Key = "prev"
- EndProperty
- BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":4D5C
- Key = "next"
- EndProperty
- BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":50F6
- Key = "last"
- EndProperty
- BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":5490
- Key = "xx"
- EndProperty
- BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":582A
- Key = "define"
- EndProperty
- BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":5BC4
- Key = "exec"
- EndProperty
- BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":5F5E
- Key = "xz"
- EndProperty
- BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":62F8
- Key = "sc"
- EndProperty
- BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":6692
- Key = "sx"
- EndProperty
- BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":6A2C
- Key = "cx"
- EndProperty
- BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":6DC6
- Key = "zd"
- EndProperty
- BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":7160
- Key = "dz"
- EndProperty
- BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":74FA
- Key = "ph"
- EndProperty
- BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":7894
- Key = "fz"
- EndProperty
- BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":7C2E
- Key = "dw"
- EndProperty
- BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":7FC8
- Key = "hf"
- EndProperty
- BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":8362
- Key = "pz"
- EndProperty
- BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":86FC
- Key = "check"
- EndProperty
- BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":8A96
- Key = "qs"
- EndProperty
- BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":8E30
- Key = "fullcheck"
- EndProperty
- BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":91CA
- Key = "qq"
- EndProperty
- BeginProperty ListImage36 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":9564
- Key = "bcw"
- EndProperty
- BeginProperty ListImage37 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "采购系统_发票录入.frx":98FE
- Key = "ye"
- EndProperty
- EndProperty
- End
- Begin VSFlex8Ctl.VSFlexGrid WglrGrid
- Height = 3345
- Left = 120
- TabIndex = 1
- Top = 2280
- Width = 10680
- _ExtentX = 18838
- _ExtentY = 5900
- 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 = -2147483640
- BackColorFixed = 12640511
- ForeColorFixed = -2147483630
- BackColorSel = -2147483643
- ForeColorSel = -2147483640
- BackColorBkg = 16777215
- BackColorAlternate= 16777215
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 1
- AllowSelection = 0 'False
- AllowBigSelection= 0 'False
- AllowUserResizing= 0
- 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
- 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 'False
- ShowComboButton = -1 'True
- WordWrap = -1 'True
- TextStyle = 0
- TextStyleFixed = 0
- OleDragMode = 0
- OleDropMode = 0
- DataMode = 0
- VirtualData = -1 'True
- Begin VSFlex8Ctl.VSFlexGrid HjGrid
- Height = 885
- Left = 0
- TabIndex = 14
- Top = 2400
- Width = 7545
- _ExtentX = 13309
- _ExtentY = 1561
- 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 = 14671839
- ForeColor = -2147483640
- BackColorFixed = -2147483633
- ForeColorFixed = -2147483630
- BackColorSel = -2147483643
- ForeColorSel = -2147483640
- BackColorBkg = 16777215
- BackColorAlternate= 14671839
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 1
- AllowSelection = 0 'False
- AllowBigSelection= 0 'False
- AllowUserResizing= 0
- 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
- 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 'False
- ShowComboButton = -1 'True
- WordWrap = -1 'True
- TextStyle = 0
- TextStyleFixed = 0
- OleDragMode = 0
- OleDropMode = 0
- DataMode = 0
- VirtualData = -1 'True
- End
- End
- Begin VB.Label Lab_Title
- AutoSize = -1 'True
- BackColor = &H80000018&
- BackStyle = 0 'Transparent
- Caption = "单据标题自动调整"
- BeginProperty Font
- Name = "宋体"
- Size = 15
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00000000&
- Height = 300
- Left = 4440
- TabIndex = 13
- Top = 840
- Width = 2520
- End
- Begin VB.Label Lab_BillId
- AutoSize = -1 'True
- BackColor = &H0080C0FF&
- Height = 270
- Left = 7680
- TabIndex = 12
- Top = 600
- Visible = 0 'False
- Width = 2490
- End
- Begin VB.Label Lab_Djclzt
- BackColor = &H0000FFFF&
- Caption = "1"
- ForeColor = &H00808080&
- Height = 255
- Left = 10320
- TabIndex = 11
- Top = 600
- Visible = 0 'False
- Width = 285
- End
- Begin VB.Label Lab_OperStatus
- BackColor = &H000080FF&
- Caption = "1"
- Height = 345
- Left = 10290
- TabIndex = 10
- Top = 960
- Visible = 0 'False
- Width = 345
- End
- Begin VB.Label Lab_Bill
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BackStyle = 0 'Transparent
- ForeColor = &H00000000&
- Height = 225
- Left = 9030
- TabIndex = 8
- Top = 6330
- Width = 735
- End
- Begin VB.Label Lab_Checker
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BackStyle = 0 'Transparent
- ForeColor = &H00000000&
- Height = 225
- Left = 7170
- TabIndex = 7
- Top = 6360
- Width = 735
- End
- Begin VB.Label TsLabel
- Alignment = 1 'Right Justify
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "单据号:"
- Height = 180
- Index = 0
- Left = 240
- TabIndex = 6
- Top = 1560
- Width = 765
- End
- End
- Attribute VB_Name = "Cg_InvoiceBill"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '***********************************************************************************************************
- '* 模 块 名 称 :发票处理
- '* 功 能 描 述 :此功能模块主要完成发票录入、修改、删除、预览打印等。
- '* 程序员姓名 :周化江
- '* 最后修改人 :周化江
- '* 最后修改时间:2001/09/18
- '* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
- '*
- '* 1.每次调入外部功能窗体,均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
- '* TextValiLock=True TextValiLock=false
- '*
- '* 2.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) "1"-浏览 "2"-新增 "3"-修改
- '*
- '* 3.Lab_Djclzt 用此标签来标识单据处理状态(默认值为1) "1"-填制单据 "2"-查询单据列表 "3"-明细帐联查单据
- '*
- '* 4.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
- '***********************************************************************************************************
- '[以下为根据实际情况设置变量
- Dim Bln_BillChange As Boolean '标识单据是否发生改动
- Dim Rec_Query As New ADODB.Recordset '单据组查询结果动态集(保存当前单据组ID)
- Public Str_QueryCondi As String '单据组查询条件(接收单据列表传递查询条件)
- Private str_SqlInvoiceType As String '发票类型查询串PeriodStarFlag, InvoiceSort, InvoiceKind
- Private str_SqlInvoice As String '发票类型查询串PeriodStarFlag, InvoiceSort, InvoiceKind
- Private Int_InvoiceType As Integer '发票类型
- Dim Str_RightEdit As String '单据编辑(新增、修改、删除)权限索引
- Dim Str_RightCheck As String '单据审核(审核、弃审)权限索引
- ']
- '以下为固定使用变量(单据)
- Dim BillCode As String '单据设计编码(索引号)
- Dim Var_Bill() As Variant '用来返回单据设计信息
- Dim ReportTitle As String '报表主标题
- Dim Tsxx As String '系统提示信息
- '以下为固定使用变量(网格)
- Dim Cxnrrec As New ADODB.Recordset '显示查询内容动态集
- Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
- Dim GridCode As String '显示网格网格代码
- Dim GridInf() As Variant '整个网格设置信息
- 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 '文本框内容变换控制锁
- Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
- Dim jdzygs As Integer
- jdzygs = 19 '在单据录入中,此焦点转移控制值一定小于等于文本框个数,否则网格回车键将不支持.
- Select Case KeyAscii
- Case vbKeyReturn
- If Kjjdzy(jdzygs) Then
- KeyAscii = 0
- End If
- Case 39 '屏蔽字符"'"
- KeyAscii = 0
- End Select
- End Sub
- Private Sub Form_Load() '窗 体 装 入
- '初始化各种锁值(Fixed)
- Changelock = False '网格行列改变控制锁
- Gdtlock = False '滚动条滚动控制
- Yxxpdlock = True '字段有效性判断锁
- Hyxxpdlock = True '行有效性判断锁
- Wbkbhlock = False '文本框内容改变锁
- '设置权限索引
- Select Case Me.InvoiceType '发票类型
- Case 1 '期初普通发票
- '单据编辑(新增、修改、删除)权限索引
- Str_RightEdit = "Cg_spinvoice_edit"
- '单据审核(审核、弃审)权限索引
- Str_RightCheck = "Cg_spinvoice_check"
- Case 2 '期初增值税发票
- '单据编辑(新增、修改、删除)权限索引
- Str_RightEdit = "Cg_szinvoice_edit"
- '单据审核(审核、弃审)权限索引
- Str_RightCheck = "Cg_szinvoice_check"
- Case 3 '蓝字普通发票
- '单据编辑(新增、修改、删除)权限索引
- Str_RightEdit = "Cg_pfpinput_edit"
- '单据审核(审核、弃审)权限索引
- Str_RightCheck = "Cg_pfpinput_check"
- Case 4 '蓝字增值税发票
- '单据编辑(新增、修改、删除)权限索引
- Str_RightEdit = "Cg_zfpinput_edit"
- '单据审核(审核、弃审)权限索引
- Str_RightCheck = "Cg_zfpinput_check"
- Case 5 '红字普通发票
- '单据编辑(新增、修改、删除)权限索引
- Str_RightEdit = "Cg_hfpinput_edit"
- '单据审核(审核、弃审)权限索引
- Str_RightCheck = "Cg_hfpinput_check"
- Case 6 '红字增值税发票
- '单据编辑(新增、修改、删除)权限索引
- Str_RightEdit = "Cg_hzfpinput_edit"
- '单据审核(审核、弃审)权限索引
- Str_RightCheck = "Cg_hzfpinput_check"
- End Select
- '调入单据信息(需要修改BillCode)
- Select Case Me.InvoiceType '发票类型
- Case 1, 3, 5
- BillCode = "1106"
- Case 2, 4, 6
- BillCode = "1108"
- End Select
- Call Sub_ReadBillInfo(BillCode, Me, Var_Bill())
- Select Case Me.InvoiceType '发票类型
- Case 1, 2
- Lab_Title = "(期初)" & Trim(Var_Bill(2))
- Case 3, 4
- Lab_Title = Trim(Var_Bill(2))
- Lab_Title.ForeColor = &H0&
- Case 5, 6
- Lab_Title = Trim(Var_Bill(2)) & "(红字)"
- Lab_Title.ForeColor = &HFF&
- End Select
- Select Case Me.InvoiceType
- Case 1
- str_SqlInvoiceType = " and ( PeriodStarFlag = 1 and InvoiceSort=0 ) "
- Case 2
- str_SqlInvoiceType = " and ( PeriodStarFlag = 1 and InvoiceSort=1 ) "
- Case 3
- str_SqlInvoiceType = " and ( PeriodStarFlag = 0 and InvoiceSort=0 and InvoiceKind=0) "
- Case 4
- str_SqlInvoiceType = " and ( PeriodStarFlag = 0 and InvoiceSort=1 and InvoiceKind=0) "
- Case 5
- str_SqlInvoiceType = " and ( PeriodStarFlag = 0 and InvoiceSort=0 and InvoiceKind=1) "
- Case 6
- str_SqlInvoiceType = " and ( PeriodStarFlag = 0 and InvoiceSort=1 and InvoiceKind=1) "
- End Select
- Lab_Title.Move (Me.Width - Lab_Title.Width) / 2, 800
- '报表编码
- XtReportCode = Var_Bill(5)
- Load Dyymctbl
- '以下为文本框处理程序(Fixed)
- TextGroupCode = Var_Bill(3)
- Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
- Call Wbkcsh
- '调入网格并记录一些网格信息(Fixed)
- GridCode = Var_Bill(4) '网格属性编码
- Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
- Qslz = GridInf(1)
- Sjhgd = GridInf(2)
- Fzxwghs = GridInf(4)
- Sfblbzkd = GridInf(5)
- Shsfts = GridInf(6)
- Sfxshjwg = GridInf(7)
- Szzls = WglrGrid.Cols - 1
- Pmbcsjhs = Int((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) / Sjhgd) - Fzxwghs - 1
- For jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
- WglrGrid.RowHeight(jsqte) = Sjhgd
- Next jsqte
- '初始化合计网格(Fixed)
- Call Cshhjwg
- '初始化Chk_Xf位置
- Chk_Xf.Top = LrText(1).Top - 500
- Chk_Xf.Left = LrText(1).Left
- '单据变动置为False(Fixed)
- Bln_BillChange = False
- '调入数据初始化模块(Fixed)
- Lab_Djclzt.Caption = Xtcdcs
- Call Sjcsh(Trim(Lab_Djclzt.Caption))
- End Sub
- Private Sub Form_Unload(Cancel As Integer) '窗体卸载
- '是否保存已修改单据
- Dim YAnswer As Integer
- If Lab_OperStatus.Caption = "2" Or Lab_OperStatus.Caption = "3" Then
- Tsxx = "单据尚未保存,是否退出?"
- YAnswer = Xtxxts(Tsxx, 2, 2)
- If YAnswer <> 1 Then
- Cancel = 1
- Exit Sub
- End If
- End If
- '卸载打印页面窗体
- Unload Dyymctbl
- '判断单据是否发生变化,并返回相应标识
- If Bln_BillChange Then
- Xtfhcs = "1"
- Else
- Xtfhcs = "0"
- End If
- End Sub
- Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
- Dim Sqlstr As String '查询单据列表条件
- '[>>根据实际情况初始化
- Select Case Str_Pzclzt
- Case "1" '填制单据
- '调入用户查询结果动态集(默认显示用户当前操作业务日期的单据)
- Sqlstr = "SELECT InvoiceMainID FROM Cg_InvoiceMain where InvoiceDate=convert(datetime,'" & Xtrq & "') " & str_SqlInvoiceType & " ORDER BY InvoiceMainID "
- Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- '新增单据
- Call Sub_AddBill
- Case "2" '查询单据(单据列表)
- '填充查询单据标识
- Lab_BillId.Caption = XT_BillID
- Str_QueryCondi = Xtcdcsfz
- Call Sub_ShowBill
- Call Sub_OperStatus("10")
- '调入用户查询结果动态集
- Sqlstr = "SELECT DISTINCT InvoiceMainID From Cg_V_InvoiceBill a " & Str_QueryCondi & " ORDER BY InvoiceMainID"
- Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- Rec_Query.Find "InvoiceMainID=" & Val(Lab_BillId.Caption)
- Case "3" '明细帐联查单据
- '填充查询单据标识
- Lab_BillId.Caption = XT_BillID
- '设置工具条显示
- With Tlb_Action
- .Buttons("xz").Enabled = False '新增
- .Buttons("xg").Enabled = False '修改
- .Buttons("sc").Enabled = False '删除
- .Buttons("fgh0").Enabled = False '分隔行
- .Buttons("zh").Enabled = False '增行
- .Buttons("sh").Enabled = False '删行
- .Buttons("fgh1").Enabled = False '分隔行
- .Buttons("bc").Enabled = False '保存
- .Buttons("fq").Enabled = False '放弃
- .Buttons("shsh").Enabled = False '审核
- .Buttons("shqs").Enabled = False '弃审
- .Buttons("fgh2").Enabled = False '分隔行
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- .Buttons("fgh5").Enabled = False '分割行
- End With
- Call Sub_ShowBill
- '设置操作状态为浏览
- Lab_OperStatus.Caption = "1"
- '录入文本框
- For jsqte = Max_Text_Index To 0 Step -1
- LrText(jsqte).Enabled = False
- Next jsqte
- End Select
- '<<]
- End Sub
- Private Sub Sub_ShowBill() '根据当前单据ID显示整张单据内容
- '过程默认参数为当前窗体中单据ID:Lab_BillID
- Dim Sqlstr As String '临时使用字符串
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim jsqte As Long '临时计数器
- '禁止网格刷新动作,为加快网格显示速度(Fixed)
- WglrGrid.Redraw = False
- '本张单据查询字符串
- Sqlstr = "SELECT * from Cg_V_InvoiceBill where InvoiceMainID='" & Val(Lab_BillId.Caption) & "' Order By Cg_V_InvoiceBill.InvoiceSubID"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- With RecTemp
- WglrGrid.Rows = WglrGrid.FixedRows
- If .EOF Then
- WglrGrid.Redraw = True
- Exit Sub
- Else
- '根据发票类型进行改变
- If RecTemp.Fields("PeriodStarFlag") = 1 And RecTemp.Fields("InvoiceSort") = 0 And RecTemp.Fields("InvoiceKind") = 0 Then
- Me.InvoiceType = 1
- ElseIf RecTemp.Fields("PeriodStarFlag") = 1 And RecTemp.Fields("InvoiceSort") = 1 And RecTemp.Fields("InvoiceKind") = 0 Then
- Me.InvoiceType = 2
- ElseIf RecTemp.Fields("PeriodStarFlag") = 0 And RecTemp.Fields("InvoiceSort") = 0 And RecTemp.Fields("InvoiceKind") = 0 Then
- Me.InvoiceType = 3
- ElseIf RecTemp.Fields("PeriodStarFlag") = 0 And RecTemp.Fields("InvoiceSort") = 1 And RecTemp.Fields("InvoiceKind") = 0 Then
- Me.InvoiceType = 4
- ElseIf RecTemp.Fields("PeriodStarFlag") = 0 And RecTemp.Fields("InvoiceSort") = 0 And RecTemp.Fields("InvoiceKind") = 1 Then
- Me.InvoiceType = 5
- ElseIf RecTemp.Fields("PeriodStarFlag") = 0 And RecTemp.Fields("InvoiceSort") = 1 And RecTemp.Fields("InvoiceKind") = 1 Then
- Me.InvoiceType = 6
- End If
- Select Case Me.InvoiceType '发票类型
- Case 1, 2
- Lab_Title = "(期初)" & Trim(Var_Bill(2))
- Case 3, 4
- Lab_Title = Trim(Var_Bill(2))
- Lab_Title.ForeColor = &H0&
- Case 5, 6
- Lab_Title = Trim(Var_Bill(2)) & "(红字)"
- Lab_Title.ForeColor = &HFF&
- End Select
- '[>>显示单据头
- TextChangeLock = True '文本框加锁
- LrText(1).Text = Trim("" & .Fields("InvoiceNum")) '单据号
- LrText(0).Text = Format(.Fields("InvoiceDate"), "yyyy-mm-dd") '发票日期
- LrText(2).Text = Trim("" & .Fields("InvoiceNumZs")) '原发票号
- LrText(3).Tag = Trim("" & .Fields("InvoiceCode")) '发票类型编码
- LrText(3).Text = Trim("" & .Fields("InvoiceName")) '发票类型名称
- LrText(4).Tag = Trim("" & .Fields("OrderFormMainID")) '订单ID
- LrText(4).Text = Trim("" & .Fields("OrderFormNum")) '订单号
- LrText(5).Tag = Trim("" & .Fields("SupplierCode")) '供应商编码
- LrText(5).Text = Trim("" & .Fields("SupplierName")) '供应商名称
- LrText(6).Tag = Trim("" & .Fields("PurTypeCode")) '采购类型编码
- LrText(6).Text = Trim("" & .Fields("PurTypeName")) '采购类型名称
- LrText(7).Tag = Trim("" & .Fields("DeptCode")) '部门编码
- LrText(7).Text = Trim("" & .Fields("DeptName")) '部门名称
- LrText(8).Tag = Trim("" & .Fields("PersonCode")) '业务员编码
- LrText(8).Text = Trim("" & .Fields("PersonName")) '业务员
- LrText(9).Tag = Trim("" & .Fields("SSCode")) '结算方式编码
- LrText(9).Text = Trim("" & .Fields("SSName")) '结算方式名称
- LrText(10).Tag = Trim("" & .Fields("PayCode")) '付款条件编码
- LrText(10).Text = Trim("" & .Fields("Payname")) '付款条件名称
- LrText(11).Tag = Trim("" & .Fields("TransferWayCode")) '运输方式编码
- LrText(11).Text = Trim("" & .Fields("TransferWayName")) '运输方式名称
- LrText(12).Tag = Trim("" & .Fields("ForeignCurrCode")) '货币编码
- LrText(12).Text = Trim("" & .Fields("ForeignCurrName")) '货币名称
- LrText(13).Text = Format(Val("" & .Fields("AccRate")), "###0." + String(4, "0")) '汇率
- LrText(13).Tag = IIf(IsNull(.Fields("ConVertFlag")), 0, .Fields("ConVertFlag")) '外币的乘与除 1为乘,0为除
- LrText(14).Tag = Trim("" & .Fields("ChargeDept")) '费用单位编码
- LrText(14).Text = Trim("" & .Fields("ChargeDeptName")) '费用单位名称
- LrText(15).Text = Trim("" & .Fields("Remark")) '备注
- LrText(16).Text = Trim("" & .Fields("Maker")) '制单人
- LrText(17).Text = Trim("" & .Fields("Checker")) '审核人
- LrText(18).Text = IIf(IsNull(.Fields("BanlanceDate")) Or Trim("" & .Fields("BanlanceDate")) = "", "", Format(.Fields("BanlanceDate"), "yyyy-mm-dd")) '结算日期
- TextChangeLock = False '文本框解锁
- If .Fields("InvoiceFlag") Then '现付标志
- Chk_Xf.Value = 0
- Else
- Chk_Xf.Value = 1
- End If
- '<<]
- End If
- jsqte = WglrGrid.FixedRows
- WglrGrid.Clear 1
- Do While Not .EOF
- WglrGrid.AddItem ""
- '[>>显示单据分录
- WglrGrid.TextMatrix(jsqte, 0) = "*" '数据有效行标识(必填)
- WglrGrid.TextMatrix(jsqte, 3) = IIf(.Fields("IsCharge") = True, 1, 0) '是否费用
- WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("MNumber") & "") '物料编码
- WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MName") & "") '物料名称
- WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "") '规格型号
- WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PurUnitName") & "") '计量单位
- Select Case Me.InvoiceType '发票类型
- Case 1, 3 '蓝字普通发票
- WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = IIf(IsNull(.Fields("Quantity")) Or .Fields("Quantity") = 0, "", .Fields("Quantity").Value) '数量
- WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = IIf(IsNull(.Fields("PriceYb")) Or .Fields("PriceYb") = 0, "", .Fields("PriceYb").Value) '单价(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = IIf(IsNull(.Fields("MoneyYb")) Or .Fields("MoneyYb") = 0, "", .Fields("MoneyYb").Value) '金额(原币)
- Case 2, 4 '蓝字专用发票
- WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = IIf(IsNull(.Fields("TaxRate")) Or .Fields("TaxRate") = 0, "", .Fields("TaxRate").Value) '税率
- WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = IIf(IsNull(.Fields("Quantity")) Or .Fields("Quantity") = 0, "", .Fields("Quantity").Value) '数量
- WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = IIf(IsNull(.Fields("PriceYb")) Or .Fields("PriceYb") = 0, "", .Fields("PriceYb").Value) '单价(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = IIf(IsNull(.Fields("MoneyYb")) Or .Fields("MoneyYb") = 0, "", .Fields("MoneyYb").Value) '金额(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = IIf(IsNull(.Fields("TaxMoneyYb")) Or .Fields("TaxMoneyYb") = 0, "", .Fields("TaxMoneyYb").Value) '税额(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = IIf(IsNull(.Fields("TotalMoneyYb")) Or .Fields("TotalMoneyYb") = 0, "", .Fields("TotalMoneyYb").Value) '价税合计(原币)
- Case 5 '红字普通发票
- WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = IIf(IsNull(.Fields("Quantity")) Or .Fields("Quantity") = 0, "", (-1) * .Fields("Quantity").Value) '数量
- WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = IIf(IsNull(.Fields("PriceYb")) Or .Fields("PriceYb") = 0, "", .Fields("PriceYb").Value) '单价(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = IIf(IsNull(.Fields("MoneyYb")) Or .Fields("MoneyYb") = 0, "", (-1) * .Fields("MoneyYb").Value) '金额(原币)
- Case 6 '红字专用发票
- WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = IIf(IsNull(.Fields("TaxRate")) Or .Fields("TaxRate") = 0, "", .Fields("TaxRate").Value) '税率
- WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = IIf(IsNull(.Fields("Quantity")) Or .Fields("Quantity") = 0, "", (-1) * .Fields("Quantity").Value) '数量
- WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = IIf(IsNull(.Fields("PriceYb")) Or .Fields("PriceYb") = 0, "", .Fields("PriceYb").Value) '单价(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = IIf(IsNull(.Fields("MoneyYb")) Or .Fields("MoneyYb") = 0, "", (-1) * .Fields("MoneyYb").Value) '金额(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = IIf(IsNull(.Fields("TaxMoneyYb")) Or .Fields("TaxMoneyYb") = 0, "", (-1) * .Fields("TaxMoneyYb").Value) '税额(原币)
- WglrGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = IIf(IsNull(.Fields("TotalMoneyYb")) Or .Fields("TotalMoneyYb") = 0, "", (-1) * .Fields("TotalMoneyYb").Value) '价税合计(原币)
- End Select
- '<<]
- WglrGrid.RowHeight(jsqte) = Sjhgd
- .MoveNext
- jsqte = jsqte + 1
- Loop
- End With
- '调整网格(Fixed)
- Call Sub_AdjustGrid
- '计算合计数据(Fixed)
- For jsqte = Qslz To WglrGrid.Cols - 1
- Call Sjhj(jsqte)
- Next jsqte
- '将网格刷新解禁(Fixed)
- WglrGrid.Redraw = True
- '设置审核弃审按钮状态
- If Xtcdcs <> "3" Then
- Call Sub_CheckStatus
- End If
- End Sub
- Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
- '屏蔽文本框,下拉组合框有效性判断
- Valilock = True
- '屏蔽网格失去焦点产生的有效性判断
- Changelock = True
- Select Case Button.Key
- Case "yl" '预 览
- If Fun_Drfrmyxxpd Then
- BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
- End If
- Case "dy" '打 印
- If Fun_Drfrmyxxpd Then
- Dim yhAnswer As Integer '打印提示
- '用户确认是否打印单据
- Tsxx = "请确认是否打印当前单据?"
- yhAnswer = Xtxxts(Tsxx, 2, 2)
- If yhAnswer = 2 Then
- Exit Sub
- End If
- BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
- End If
- Case "xz" '新 增
- Call Sub_AddBill
- Case "xg" '修 改
- Call Sub_EditBill
- Case "sc" '删 除
- Call Sub_DeleteBill
- Case "zh" '增 行
- Call zjlrfl
- Case "sh" '删 行
- Call Scdqfl
- Case "bc" '保 存
- If Fun_Drfrmyxxpd Then
- Call Sub_SaveBill
- End If
- Case "fq" '放 弃
- Call Sub_AbandonBill
- Case "shsh" '审 核
- Call Sub_CheckBill
- Case "shqs" '弃 审
- Call Sub_AbandonCheck
- Case "first" '首 张
- Call Sub_First
- Case "prev" '上 张
- Call Sub_Prev
- Case "next" '下 张
- Call Sub_Next
- Case "last" '末 张
- Call Sub_Last
- Case "bz" '帮 助
- Call F1bz
- Case "fh" '退 出
- Unload Me
- End Select
- '解 锁
- Valilock = False
- Changelock = False
- TextChangeLock = False
- End Sub
- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '支持热键操作
- Select Case KeyCode
- Case vbKeyF5 '增加单据
- If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
- Call Sub_AddBill
- End If
- Case vbKeyF3 '修改单据
- If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
- Call Sub_EditBill
- End If
- Case vbKeyF6 '保存单据
- If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
- If Fun_Drfrmyxxpd Then Call Sub_SaveBill
- End If
- End Select
- End Sub
- Private Sub Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
- With Tlb_Action
- Select Case Str_Status
- Case "10" '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
- '工具条
- .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("first").Enabled = True '首张
- .Buttons("prev").Enabled = True '上张
- .Buttons("next").Enabled = True '下张
- .Buttons("last").Enabled = True '末张
- .Buttons("bz").Enabled = True '帮助
- .Buttons("fh").Enabled = True '退出
- '设置审核弃审按钮状态
- Call Sub_CheckStatus
- '设置文本框录入状态
- Call Sub_LrtextStatus(False)
- '设置现付选择框状态
- Chk_Xf.Enabled = False
- Case "20" '新增单据((录入)新增一张单据 、(列表)新增一张单据)
- '工具条
- .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("shsh").Enabled = False '审核
- .Buttons("shqs").Enabled = False '弃审
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- .Buttons("bz").Enabled = True '帮助
- .Buttons("fh").Enabled = True '退出
- '设置文本框录入状态
- Call Sub_LrtextStatus(True)
- '设置现付选择框状态
- Chk_Xf.Enabled = True
- Case "30" '修改((录入)调入修改功能、(列表)调入修改功能)
- '工具条
- .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("shsh").Enabled = False '审核
- .Buttons("shqs").Enabled = False '弃审
- .Buttons("first").Enabled = False '首张
- .Buttons("prev").Enabled = False '上张
- .Buttons("next").Enabled = False '下张
- .Buttons("last").Enabled = False '末张
- .Buttons("bz").Enabled = True '帮助
- .Buttons("fh").Enabled = True '退出
- '设置文本框录入状态
- Call Sub_LrtextStatus(True)
- '设置现付选择框状态
- Chk_Xf.Enabled = True
- End Select
- End With
- End Sub
- Private Sub Sub_LrtextStatus(TextEnabled As Boolean) '设置录入文本框状态
- '录入文本框状态设置
- If TextEnabled Then
- For jsqte = Max_Text_Index To 0 Step -1
- '判断文本框是否可编辑
- If Textboolean(jsqte, 5) Then
- LrText(jsqte).Enabled = True
- Else
- LrText(jsqte).Enabled = False
- End If
- Next jsqte
- Else
- For jsqte = Max_Text_Index To 0 Step -1
- LrText(jsqte).Enabled = False
- Next jsqte
- End If
- End Sub
- Private Sub Sub_CheckStatus() '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
- '根据当前单据状态来确定审核弃审按钮状态
- If Trim(LrText(17).Text) = "" And Trim(LrText(18).Text) = "" Then
- Tlb_Action.Buttons("shsh").Enabled = True '审核
- Tlb_Action.Buttons("shqs").Enabled = False '弃审
- ElseIf Trim(LrText(17).Text) <> "" And Trim(LrText(18).Text) = "" Then
- Tlb_Action.Buttons("shsh").Enabled = False '审核
- Tlb_Action.Buttons("shqs").Enabled = True '弃审
- Else
- Tlb_Action.Buttons("shsh").Enabled = False '审核
- Tlb_Action.Buttons("shqs").Enabled = False '弃审
- End If
- If Trim(LrText(16).Text) = "" Then
- Tlb_Action.Buttons("shsh").Enabled = False '审核
- Tlb_Action.Buttons("shqs").Enabled = False '弃审
- End If
- End Sub
- Private Sub Wbkcl() '文本框录入之前处理(根据实际情况)
- Dim xswbrr As String
- With WglrGrid
- Zdlrqnr = Trim(.Text)
- xswbrr = Trim(.Text)
- If GridBoolean(.Col, 3) Then '列表框录入
- '填充列表框程序
- Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
- 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) As Boolean '录入数据字段有效性判断,同时进行字段录入事后处理
- '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
- Dim Str_JudgeText As String '临时有效性判断字段内容
- Dim Coljsq As Long '临时列计数器
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim Sqlstr As String '临时使用查询字符串
- 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 Not Trim(Str_JudgeText) = "" Then
- '1.放置字段有效性判断
- Sqlstr = "SELECT MNumber,MName,Model,PurUnitName,Cess ,IsCharge From Gy_Material Where (MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "') and IsPurchase=1 "
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- If RecTemp.EOF Then
- Tsxx = "此物料编码不存在或不具备采购属性!"
- GoTo Lrcwcl
- End If
- '2.放置字段事后处理程序
- For Coljsq = .FixedRows To .Rows - 1
- If .TextMatrix(Coljsq, 0) = "*" And Coljsq <> Dqpdwgh Then
- If Trim(.TextMatrix(Coljsq, Sydz("001", GridStr(), Szzls))) = _
- Trim(RecTemp.Fields("MNumber") & "") Then
- Tsxx = "在这张单据中,此物料编码已存在!"
- GoTo Lrcwcl
- Exit For
- End If
- End If
- Next Coljsq
- .TextMatrix(Dqpdwgh, 2) = RecTemp.Fields("Cess")
- .TextMatrix(Dqpdwgh, 3) = IIf(RecTemp.Fields("IsCharge") = True, 1, 0)
- .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "") '显示物料编码
- .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "") '显示物料名称
- .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "") '显示物料规格型号
- .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim("" & RecTemp.Fields("PurUnitName")) '计量单位
- Select Case Me.InvoiceType '发票类型
- Case 2, 4, 6 '专用发票
- .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = IIf(IsNull(RecTemp.Fields("Cess")) Or RecTemp.Fields("Cess") = 0, "", RecTemp.Fields("Cess").Value)
- Call Sub_JoinCount(Dqpdwgh, Sydz("006", GridStr(), Szzls)) '数量
- End Select
- Else
- .TextMatrix(Dqpdwgh, 2) = ""
- .TextMatrix(Dqpdwgh, 3) = ""
- .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""
- .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""
- .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""
- Select Case Me.InvoiceType '发票类型
- Case 2, 4, 6 '专用发票
- .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = ""
- Call Sub_JoinCount(Dqpdwgh, Sydz("006", GridStr(), Szzls)) '数量
- End Select
- End If
- Case "005"
- Select Case Me.InvoiceType '发票类型
- Case 1, 3, 5 '普通发票
- '1.放置字段有效性判断
- If (Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))))) And Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))) <> "" Then
- Tsxx = "请输入数字!"
- GoTo Lrcwcl
- Else
- .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Val(Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))))
- If Val(Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)))) < 0 Then
- Tsxx = "数量不能小于零!"
- GoTo Lrcwcl
- End If
- End If
- '2.放置字段事后处理程序
- '根据公式计算结果
- Call Sub_JoinCount(Dqpdwgh, Sydz("005", GridStr(), Szzls)) '数量
- End Select
- Case "006" '数量
- Select Case Me.InvoiceType '发票类型
- Case 2, 4, 6 '专用发票
- '1.放置字段有效性判断
- If (Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))))) And Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) <> "" Then
- Tsxx = "请输入数字!"
- GoTo Lrcwcl
- Else
- .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Val(Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))))
- If Val(Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)))) < 0 Then
- Tsxx = "数量不能小于零!"
- GoTo Lrcwcl
- End If
- End If
- '2.放置字段事后处理程序
- '根据公式计算结果
- Call Sub_JoinCount(Dqpdwgh, Sydz("006", GridStr(), Szzls)) '数量
- Case 1, 3, 5 '普通发票
- '1.放置字段有效性判断
- '2.放置字段事后处理程序
- Call Sub_JoinCount(Dqpdwgh, Sydz("006", GridStr(), Szzls)) '单价(根据公式计算结果)
- End Select
- Case "007"
- '1.放置字段有效性判断
- '2.放置字段事后处理程序
- Select Case Me.InvoiceType '发票类型
- Case 1, 3, 5 '普通发票
- If Val(Trim(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)))) < 0 Then
- Tsxx = "金额不能小于零!"
- GoTo Lrcwcl
- End If
- End Select
- Call Sub_JoinCount(Dqpdwgh, Sydz("007", GridStr(), Szzls)) '单价(根据公式计算结果)
- Case "008"
- '1.放置字段有效性判断
- '2.放置字段事后处理程序
- Select Case Me.InvoiceType '发票类型
- Case 2, 4, 6 '专用发票
- If Val(Trim(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)))) < 0 Then
- Tsxx = "金额不能小于零!"
- GoTo Lrcwcl
- End If
- End Select
- Call Sub_JoinCount(Dqpdwgh, Sydz("008", GridStr(), Szzls)) '金额(根据公式计算结果)
- Case "010"
- Select Case Me.InvoiceType '发票类型
- Case 2, 4, 6 '专用发票
- '1.放置字段有效性判断
- '2.放置字段事后处理程序
- If Val(Trim(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))) < 0 Then
- Tsxx = "税价合计不能小于零!"
- GoTo Lrcwcl
- End If
- Call Sub_JoinCount(Dqpdwgh, Sydz("010", GridStr(), Szzls)) '金额(根据公式计算结果)
- End Select
- '<<以上为自定义部分]
- End Select
- '字段录入正确后为零字段清空(Fixed)
- Call Qkwlzd(Dqpdwgh, Dqpdwgl)
- '字段录入正确后进行数据合计(Fixed)
- For Coljsq = Qslz To .Cols - 1
- Call Sjhj(Coljsq)
- Next Coljsq
- '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
- sjzdyxxpd = True
- Yxxpdlock = True
- Exit Function
- End With
- Lrcwcl: '录入错误处理
- With WglrGrid
- '给出错误提示信息
- Call Xtxxts(Tsxx, 0, 1)
- '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
- Changelock = True
- .Select Dqpdwgh, Dqpdwgl
- Changelock = False
- Call xswbk
- '函数返回False
- sjzdyxxpd = False
- Exit Function
- End With
- End Function
- Private Sub Sub_JoinCount(Lng_CountRow As Long, Lng_CountCol As Long) '当网格列值发生改变时,处理网格列之间的关联计算(可选)
- '过程参数:Lng_CountRow,Lng_CountCol 网格改变内容所处行列值
- With WglrGrid
- If Int(Me.InvoiceType / 2) = Me.InvoiceType / 2 Then '专用发票
- Select Case GridStr(Lng_CountCol, 1) '判断网格列对应逻辑编号
- Case "006"
- If Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = ""
- End If
- Case "007"
- If Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) = 0 Then
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- Else
- If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = ""
- End If
- End If
- Case "008" '金额改变
- If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) <> 0 Then
- If Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))), "###0." + String(Xtdjxsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- End If
- Else
- .TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = ""
- End If
- Case "010"
- If Val(.TextMatrix(Lng_CountRow, Sydz("010", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("010", GridStr(), Szzls))) / (1 + (Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) / 100)), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("010", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = ""
- End If
- If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) <> 0 Then
- If Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))), "###0." + String(Xtdjxsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- End If
- Else
- .TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) = ""
- End If
- End Select
- If Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) * (Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) / 100) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) * (Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) / 100), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = ""
- End If
- If GridStr(Lng_CountCol, 1) <> "010" Then
- If Val(.TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls))) + Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("010", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls))) + Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("010", GridStr(), Szzls)) = ""
- End If
- Else
- If .ValueMatrix(Lng_CountRow, Sydz("010", GridStr(), Szzls)) - .ValueMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = Format(.ValueMatrix(Lng_CountRow, Sydz("010", GridStr(), Szzls)) - .ValueMatrix(Lng_CountRow, Sydz("008", GridStr(), Szzls)), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("009", GridStr(), Szzls)) = ""
- End If
- End If
- Else '普通发票
- Select Case GridStr(Lng_CountCol, 1) '判断网格列对应逻辑编号
- Case "005" '数量改变
- '计算公式:单价*数量=金额
- If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- End If
- Case "006" '单价
- If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) = 0 Then
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
- Else
- If Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls)) = ""
- End If
- End If
- Case "007" '金额改变
- '计算公式:金额/数量=单价
- If Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
- If Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))) <> 0 Then
- .TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls))), "###0." + String(Xtdjxsws, "0"))
- Else
- .TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
- End If
- Else
- .TextMatrix(Lng_CountRow, Sydz("005", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("006", GridStr(), Szzls)) = ""
- .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), Szzls)) = ""
- End If
- '<<以上为自定义部分]
- End Select
- End If
- End With
- End Sub
- Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean '录入数据行有效性判断,同时进行行处理
- '函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值
- Dim Lrywlz As Long '录入有误网格列值
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- 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.放置行有效性判断程序
- '1.1首先进行单个不能为空或不能为零判断(Fixed)
- 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 Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
- Tsxx = GridStr(jsqte, 2)
- Lrywlz = jsqte
- GoTo Lrcwcl
- Exit For
- End If
- End If
- Next jsqte
- '1.2进行其他有效性判断,编写格式同1.1
- '2.放置行处理程序(当数据行通过有效性判断)
- '以上为自定义部分<<]
- End With 'WglrGrid
- '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
- Sjhzyxxpd = True
- Hyxxpdlock = True
- Exit Function
- Lrcwcl: '录入错误处理
- With WglrGrid
- '给出错误提示信息
- Call Xtxxts(Tsxx, 0, 1)
- '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
- Changelock = True
- .Select Yxxpdh, Lrywlz
- Changelock = False
- Call xswbk
- '函数返回False
- Sjhzyxxpd = False
- Exit Function
- End With
- End Function
- Private Sub Sub_AddBill() '新增一张单据
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log(Str_RightEdit, Xtczybm, 1) Then
- Exit Sub
- End If
- Select Case Me.InvoiceType '发票类型
- Case 1, 2
- If CG_StartAccountCheck <> True Then Exit Sub
- End Select
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim jsqte As Long '临时计数器
- '设置操作状态为新增(Fixed)
- Lab_OperStatus.Caption = "2"
- '设置工具条状态(Fixed)
- Call Sub_OperStatus("20")
- '清空VouchID(Fixed)
- Lab_BillId.Caption = ""
- '录入文本框清除内容
- TextChangeLock = True
- For jsqte = Max_Text_Index To 0 Step -1
- LrText(jsqte).Tag = ""
- LrText(jsqte).Text = ""
- Next jsqte
- LrText(12).Text = XtSCurrName
- LrText(12).Tag = XtSCurrCode
- LrText(13).Text = Format(1, "###0." + String(4, "0"))
- TextChangeLock = True
- '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
- LrText(16).Text = Xtczy
- LrText(17).Text = ""
- LrText(18).Text = ""
- Chk_Xf.Value = 0
- '读取最新的单据编码
- Select Case Me.InvoiceType '发票类型
- Case 1, 3 '普通发票
- BillCode = "1106"
- Case 2, 4 '专用发票
- BillCode = "1108"
- Case 5 '红字普通
- BillCode = "1107"
- Case 6 '红字专用
- BillCode = "1109"
- End Select
- LrText(1).Text = CreatBillCode(BillCode, False)
- TextChangeLock = False
- '设置订单日期默认为系统业务日期
- TextChangeLock = True
- LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
- TextChangeLock = False
- '<<]
- '重置网格(Fixed)
- With WglrGrid
- .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
- For jsqte = .FixedRows To .Rows - 1
- .RowHeight(jsqte) = Sjhgd
- Next jsqte
- WglrGrid.Clear 1
- Changelock = True
- .Select .FixedRows, Qslz
- Changelock = False
- End With
- '计算合计数据(清零)(Fixed)
- For jsqte = Qslz To WglrGrid.Cols - 1
- Call Sjhj(jsqte)
- Next jsqte
- '让第一个录入项得到焦点(Fixed)
- On Error Resume Next
- LrText(0).SetFocus
- End Sub
- Private Sub Sub_EditBill() '修改一张单据
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log(Str_RightEdit, Xtczybm, 1) Then
- Exit Sub
- End If
- '非有效单据不予进行修改动作
- If Val(Lab_BillId.Caption) = 0 Then
- Exit Sub
- End If
- '判断当前单据是否允许修改
- If Not Fun_AllowEdit Then
- Exit Sub
- End If
- '设置操作状态为修改
- Lab_OperStatus.Caption = "3"
- '设置工具条状态
- Call Sub_OperStatus("30")
- '显示制单人
- LrText(16).Text = Xtczy
- End Sub
- Private Sub Sub_DeleteBill() '删除当前单据
- Dim YAnswer As Integer '确认是否删除当前单据
- Dim jsqte As Long '临时使用计数器
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log(Str_RightEdit, Xtczybm, 1) Then
- Exit Sub
- End If
- '非有效单据不予进行删除动作
- If Val(Lab_BillId.Caption) = 0 Then
- Exit Sub
- End If
- Tsxx = "请确认是否删除当前单据?"
- YAnswer = Xtxxts(Tsxx, 2, 2)
- If YAnswer = 1 Then
- '判断当前单据是否允许删除
- If Not Fun_AllowEdit Then
- Exit Sub
- End If
- '进行事务处理
- On Error GoTo Swcwcl
- Cw_DataEnvi.DataConnect.BeginTrans
- '1.删除单据所有内容
- Cw_DataEnvi.DataConnect.Execute ("Delete Cg_InvoiceSub Where InvoiceMainID=" & Val(Lab_BillId.Caption))
- Cw_DataEnvi.DataConnect.Execute ("Delete Cg_InvoiceMain Where InvoiceMainID=" & Val(Lab_BillId.Caption))
- Cw_DataEnvi.DataConnect.CommitTrans
- '标识单据发生改动
- Bln_BillChange = True
- '单据ID置0
- Lab_BillId.Caption = 0
- Else
- Exit Sub
- End If
- '删除单据后重置状态
- '1.显示下一张单据
- Call Sub_Next
- '2.如果无下一张单据则搜索上一张单据
- If Val(Lab_BillId.Caption) = 0 Then
- Call Sub_Prev
- End If
- '3.如无单据则置单据为空状态
- If Val(Lab_BillId.Caption) = 0 Then
- '清除录入文本框
- For jsqte = Max_Text_Index To 0 Step -1
- LrText(jsqte).Tag = ""
- LrText(jsqte).Text = ""
- Next jsqte
- '重置网格(Fixed)
- With WglrGrid
- .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
- For jsqte = .FixedRows To .Rows - 1
- .RowHeight(jsqte) = Sjhgd
- Next jsqte
- WglrGrid.Clear 1
- Changelock = True
- .Select .FixedRows, Qslz
- Changelock = False
- End With
- '计算合计数据(清零)(Fixed)
- For jsqte = Qslz To WglrGrid.Cols - 1
- Call Sjhj(jsqte)
- Next jsqte
- '设置操作状态为浏览
- Lab_OperStatus = "1"
- Call Sub_OperStatus("10")
- End If
- Rec_Query.Requery
- Rec_Query.Find "InvoiceMainID=" & Val(Lab_BillId.Caption)
- Exit Sub
- Swcwcl: '单据删除时出现错误
- Cw_DataEnvi.DataConnect.RollbackTrans
- Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End Sub
- Private Sub Sub_AbandonBill() '放弃对当前单据的操作
- Dim jsqte As Long '临时使用计数器
- '先关闭录入载体(Fixed)
- Changelock = True
- Valilock = True
- Call Ycwbk
- Changelock = False
- Valilock = False
- '如果单据有效则重新显示当前单据,置单据为空状态
- If Not Rec_Query.EOF Then
- Lab_BillId.Caption = Rec_Query.Fields("InvoiceMainID")
- Call Sub_ShowBill
- Else
- '单据ID置为0
- Lab_BillId.Caption = 0
- '清除录入文本框
- For jsqte = Max_Text_Index To 0 Step -1
- LrText(jsqte).Tag = ""
- LrText(jsqte).Text = ""
- Next jsqte
- '重置网格(Fixed)
- With WglrGrid
- .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
- For jsqte = .FixedRows To .Rows - 1
- .RowHeight(jsqte) = Sjhgd
- Next jsqte
- WglrGrid.Clear 1
- Changelock = True
- .Select .FixedRows, Qslz
- Changelock = False
- End With
- '计算合计数据(清零)(Fixed)
- For jsqte = Qslz To WglrGrid.Cols - 1
- Call Sjhj(jsqte)
- Next jsqte
- End If
- '设置操作状态为浏览
- Lab_OperStatus = "1"
- Call Sub_OperStatus("10")
- End Sub
- Private Function Sub_SaveBill() As Boolean '保 存 单 据
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim Rec_VouchMain As New ADODB.Recordset '单据主表动态集
- Dim Rec_VouchSub As New ADODB.Recordset '单据子表动态集
- Dim Rowjsq As Long '网格行计数器
- Dim Coljsq As Long '网格列计数器
- Dim jsqte As Integer '临时计数器
- Dim Lng_RowCount As Long '有效数据行计数器
- Dim Lrywlz As Long '录入有误列值
- Dim int_temp As Integer '临时计数器
- Dim str_sqlTemp As String '查询字符串
- Dim Int_Year As Integer '会计年
- Dim Int_Period As Integer '会计期间
- Dim Dbl_MoneyYb As Double '发票原币金额
- Dim Dbl_MoneyBb As Double '发票本币金额
- Dim Str_Temp As String '临时使用字符串
- Sub_SaveBill = False
- '一.============先对单据内容进行有效性判断==============='
- '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
- For jsqte = 0 To Max_Text_Index
- If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
- If Not TextYxxpd(jsqte) Then
- Call TextShow(jsqte)
- Exit Function
- End If
- End If
- Next jsqte
- '先进行字段不能为空或不能为零有效性判断(Fixed)
- For jsqte = 0 To Max_Text_Index
- If Textint(jsqte, 8) = 1 Then '字段不能为空
- If Len(Trim(LrText(jsqte).Text)) = 0 Then
- Tsxx = Textstr(jsqte, 7) & "不能为空!"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(jsqte).SetFocus
- Exit Function
- End If
- Else
- If Textint(jsqte, 8) = 2 Then '字段不能为零
- If Val(Trim(LrText(jsqte).Text)) = 0 Then
- Tsxx = Textstr(jsqte, 7) & "不能为零!"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(jsqte).SetFocus
- Exit Function
- End If
- End If
- End If
- Next jsqte
- '[>>
- '可在此区域写入其他对单据表头内容的有效性判断.
- Dim rst_Temp As New ADODB.Recordset
- Select Case Me.InvoiceType '发票类型
- Case 1, 2 '期初发票
- str_sqlTemp = "SELECT ItemValue From Gy_AccInformation" & _
- " WHERE ltrim(rtrim(SystemCode)) ='Cg' and ltrim(rtrim(ItemCode))='Cg_StartAccount'"
- Set rst_Temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
- If rst_Temp.RecordCount <> 0 Then
- rst_Temp.MoveFirst
- If rst_Temp.Fields("ItemValue") = 1 Then
- Tsxx = "期初发票已经结帐!"
- Call Xtxxts(Tsxx, 0, 4)
- Exit Function
- Else
- Set rst_Temp = Cw_DataEnvi.DataConnect.Execute("SELECT Kjyear, Period FROM Gy_kjrlb where BeginFlag=1")
- If rst_Temp.RecordCount <> 0 Then
- Int_Year = rst_Temp.Fields("Kjyear").Value
- Int_Period = rst_Temp.Fields("Period").Value
- Else
- Tsxx = "会计期间表中未设开账月份!"
- Call Xtxxts(Tsxx, 0, 4)
- Exit Function
- End If
- End If
- Else
- Int_Year = Xtyear
- Int_Period = Xtmm
- End If
- Case Else
- Set rst_Temp = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Gy_kjrlb WHERE (CgJzbz = 1) AND (CONVERT(datetime, '" & Trim(LrText(0).Text) & "') BETWEEN Qsrq AND Zzrq) ")
- If rst_Temp.RecordCount <> 0 Then
- Tsxx = "发票日期所在的会计期间已经结帐!"
- Call Xtxxts(Tsxx, 0, 4)
- Exit Function
- Else
- If Year(CDate(LrText(0).Text)) < Xtyear Then
- Tsxx = "发票日期中的年份不能小于当前会计年!"
- Call Xtxxts(Tsxx, 0, 4)
- Exit Function
- End If
- End If
- Set rst_Temp = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Gy_kjrlb WHERE (CONVERT(datetime, '" & Trim(LrText(0).Text) & "') BETWEEN Qsrq AND Zzrq) ")