English
+
资源名称：ERPSYS.zip [点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：98k
源码类别：
企业管理
开发平台：
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 JC_FrmQcAss0
- BackColor = &H00C0C0C0&
- BorderStyle = 1 'Fixed Single
- Caption = "辅助核算项目期初录入_客户"
- ClientHeight = 7965
- ClientLeft = 675
- ClientTop = 720
- ClientWidth = 11400
- Icon = "基础设置_期初录入辅助核算.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form4"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 7965
- ScaleWidth = 11400
- StartUpPosition = 1 '所有者中心
- Begin VB.CommandButton Ydcommand
- Height = 300
- Left = 9030
- Picture = "基础设置_期初录入辅助核算.frx":1042
- Style = 1 'Graphical
- TabIndex = 1
- Top = 3660
- Visible = 0 'False
- Width = 300
- End
- Begin VB.PictureBox Pic_Title
- Height = 1125
- Left = 0
- Picture = "基础设置_期初录入辅助核算.frx":13CC
- ScaleHeight = 1065
- ScaleWidth = 11715
- TabIndex = 7
- Top = 570
- Width = 11775
- Begin MSComctlLib.ImageList ImageList1
- Left = 4260
- Top = 60
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 25
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":35490
- Key = "sz"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":3582A
- Key = "dy"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":35BC4
- Key = "yl"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":35F5E
- Key = "xg"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":362F8
- Key = "zh"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":36692
- Key = "sh"
- EndProperty
- BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":36A2C
- Key = "bc"
- EndProperty
- BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":36DC6
- Key = "fq"
- EndProperty
- BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":37160
- Key = "bz"
- EndProperty
- BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":374FA
- Key = "tc"
- EndProperty
- BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":37894
- Key = "bcgs"
- EndProperty
- BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":37C2E
- Key = "mrlk"
- EndProperty
- BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":37FC8
- Key = "xsxm"
- EndProperty
- BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":38362
- Key = "first"
- EndProperty
- BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":386FC
- Key = "prev"
- EndProperty
- BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":38A96
- Key = "next"
- EndProperty
- BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":38E30
- Key = "last"
- EndProperty
- BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":391CA
- Key = "xx"
- EndProperty
- BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":39564
- Key = "define"
- EndProperty
- BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":398FE
- Key = "exec"
- EndProperty
- BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":39C98
- Key = "xz"
- EndProperty
- BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":3A032
- Key = "sc"
- EndProperty
- BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":3A3CC
- Key = "sx"
- EndProperty
- BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":3A766
- Key = "cx"
- EndProperty
- BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "基础设置_期初录入辅助核算.frx":3AB00
- Key = "zd"
- EndProperty
- EndProperty
- End
- Begin VB.Label Lab_ItemClassName
- BackStyle = 0 'Transparent
- ForeColor = &H00FF0000&
- Height = 255
- Left = 6840
- TabIndex = 13
- Top = 780
- Visible = 0 'False
- Width = 2715
- End
- Begin VB.Label Lab_ItemFlag
- BackStyle = 0 'Transparent
- Caption = "核算项目"
- Height = 195
- Left = 6060
- TabIndex = 12
- Top = 780
- Visible = 0 'False
- Width = 765
- End
- Begin VB.Label Lab_Ccode
- BackStyle = 0 'Transparent
- ForeColor = &H00FF0000&
- Height = 285
- Left = 3180
- TabIndex = 11
- Top = 780
- Width = 3255
- End
- Begin VB.Label Label1
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BackStyle = 0 'Transparent
- Caption = "核算科目"
- ForeColor = &H80000008&
- Height = 195
- Index = 2
- Left = 2310
- TabIndex = 10
- Top = 780
- Width = 735
- End
- Begin VB.Label Lab_TitleText
- BackStyle = 0 'Transparent
- ForeColor = &H00FF0000&
- Height = 225
- Left = 750
- TabIndex = 9
- Top = 690
- Width = 1455
- End
- Begin VB.Label tsLabel
- BackColor = &H80000018&
- BackStyle = 0 'Transparent
- Caption = "辅助核算期初录入"
- BeginProperty Font
- Name = "宋体"
- Size = 12
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00000000&
- Height = 315
- Index = 4
- Left = 600
- TabIndex = 8
- Top = 240
- Width = 2655
- End
- End
- Begin VB.TextBox Ydtext
- BackColor = &H00C0FFFF&
- BorderStyle = 0 'None
- Height = 330
- Left = 8310
- MultiLine = -1 'True
- TabIndex = 0
- Top = 3690
- Visible = 0 'False
- Width = 1185
- End
- Begin VB.ComboBox YdCombo
- Height = 300
- Left = 8310
- Style = 2 'Dropdown List
- TabIndex = 3
- Top = 4110
- Visible = 0 'False
- Width = 1155
- End
- Begin VB.Timer Timer1
- Interval = 1
- Left = 8310
- Top = 2970
- End
- Begin VSFlex8Ctl.VSFlexGrid WglrGrid
- Height = 6225
- Left = 0
- TabIndex = 4
- Top = 1710
- Width = 11775
- _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 = -2147483640
- BackColorFixed = 12632256
- ForeColorFixed = -2147483630
- BackColorSel = -2147483635
- ForeColorSel = -2147483634
- BackColorBkg = -2147483636
- BackColorAlternate= 16777215
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 1
- AllowSelection = -1 'True
- AllowBigSelection= -1 'True
- AllowUserResizing= 0
- SelectionMode = 0
- GridLines = 1
- GridLinesFixed = 2
- GridLineWidth = 1
- Rows = 50
- Cols = 10
- FixedRows = 1
- FixedCols = 1
- 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 = 0 'False
- 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
- Begin MSComctlLib.Toolbar Tlb_Action
- Align = 1 'Align Top
- Height = 555
- Left = 0
- TabIndex = 2
- Top = 0
- Width = 11400
- _ExtentX = 20108
- _ExtentY = 979
- ButtonWidth = 820
- ButtonHeight = 926
- AllowCustomize = 0 'False
- Wrappable = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 8
- 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"
- Object.ToolTipText = "打印当前单据或Ctrl+P"
- ImageKey = "dy"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "预览"
- Key = "yl"
- ImageKey = "yl"
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "删行"
- Key = "sh"
- Object.ToolTipText = "删除当前记录行或Delete"
- ImageKey = "sh"
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "帮助"
- Key = "bz"
- ImageKey = "bz"
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "退出"
- Key = "fh"
- ImageKey = "tc"
- EndProperty
- EndProperty
- BorderStyle = 1
- Begin MSComctlLib.Toolbar GsToolbar
- Height = 525
- Left = 9720
- TabIndex = 6
- Top = 0
- Width = 1695
- _ExtentX = 2990
- _ExtentY = 926
- ButtonWidth = 1455
- ButtonHeight = 926
- AllowCustomize = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 2
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "保存格式"
- Key = "bcgs"
- ImageKey = "bcgs"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "默认列宽"
- Key = "hfmrgs"
- ImageKey = "mrlk"
- EndProperty
- EndProperty
- End
- End
- Begin VB.Label Lab_OperStatus
- BackColor = &H000080FF&
- Caption = "1"
- Height = 345
- Left = 10980
- TabIndex = 5
- Top = 1230
- Visible = 0 'False
- Width = 345
- End
- End
- Attribute VB_Name = "JC_FrmQcAss0"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '**************************************************************************************************
- '* 模 块 名 称 :期初余额录入(辅助核算)
- '* 功 能 描 述 :
- '* 程序员姓名 :魏永生
- '* 最后修改人 :
- '* 最后修改时间:2002/1/21
- '* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
- '* 1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
- '* 2.网格列存储内容注解
- '* 0-行有效标识 1-记录编辑唯一标识 2-项目编码 3-部门编码 4-个人编码 5-客户编码 6-供应商编码
- '* 3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
- '**************************************************************************************************
- '以下为自定义变量
- Dim Str_Ccode As String '核算科目
- Dim Str_ItemClassCode As String '项目类别
- Dim Int_OriYear As Integer '期初录入年度
- Dim Str_Yefx As String '余额方向
- Dim Bln_Foreign As Boolean '外币核算
- '以下为固定使用变量(网格)
- 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 Tsxx 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)
- Private Sub Form_KeyPress(KeyAscii As Integer) '控制焦点转移和限制录入字符"'"
- Select Case KeyAscii
- Case 39 '屏蔽字符"'"
- KeyAscii = 0
- End Select
- End Sub
- Private Sub Form_Load() '窗 体 装 入
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- '核算科目
- Str_Ccode = Xtcdcs
- '期初录入年度
- Int_OriYear = Xtyear
- '初始化各种锁值
- changelock = False '网格行列改变控制锁
- Gdtlock = False '滚动条滚动控制
- Yxxpdlock = True '字段有效性判断锁
- Hyxxpdlock = True '行有效性判断锁
- Wbkbhlock = False '文本框内容改变锁
- '报表主标题及报表编码
- ReportTitle = "辅助核算期初录入"
- XtReportCode = "c_qcyelrass0"
- Load Dyymctbl
- '调 入 网 格
- GridCode = "c_qcyelrass0" '网格属性编码
- 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
- SqlStr = "Select Cwzz_AccCode.*,Cwzz_ItemClass.ItemClassName FROM Cwzz_AccCode LEFT OUTER JOIN Cwzz_ItemClass ON " & _
- " Cwzz_AccCode.ItemClassCode = Cwzz_ItemClass.ItemClassCode Where Ccode='" & Str_Ccode & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- With RecTemp
- If Not .EOF Then
- Str_Yefx = Trim(.Fields("BalanceOri")) '余额方向
- Str_ItemClassCode = Trim(.Fields("ItemClassCode") & "") '项目类别
- If Trim(.Fields("ItemClassName") & "") <> "" Then
- Lab_ItemFlag.Visible = True
- Lab_ItemClassName.Visible = True
- Lab_ItemClassName.Caption = Trim(.Fields("ItemClassName") & "")
- End If
- If Not .Fields("QuantityFlag") Then
- WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("014", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("015", GridStr(), Szzls)) = True
- End If
- If Not .Fields("ForeignFlag") Then
- WglrGrid.ColHidden(Sydz("016", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("017", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("018", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("019", GridStr(), Szzls)) = True
- End If
- If Not .Fields("ItemFlag") Then '非项目核算
- WglrGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("002", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("020", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("021", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("022", GridStr(), Szzls)) = True
- WglrGrid.ColHidden(Sydz("023", GridStr(), Szzls)) = True
- End If
- If Not .Fields("DeptFlag") Then '非部门核算
- WglrGrid.ColHidden(Sydz("003", GridStr(), Szzls)) = True
- End If
- If Not .Fields("PersonFlag") Then '非个人核算
- WglrGrid.ColHidden(Sydz("004", GridStr(), Szzls)) = True
- End If
- If Not .Fields("CusFlag") Then '非客户核算
- WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = True
- End If
- If Not .Fields("SupplierFlag") Then '非供应商核算
- WglrGrid.ColHidden(Sydz("006", GridStr(), Szzls)) = True
- End If
- If .Fields("ForeignFlag") Then
- Bln_Foreign = True
- Else
- Bln_Foreign = False
- End If
- Lab_Ccode.Caption = Trim(.Fields("Ccode")) & " " & Trim(.Fields("Cname"))
- End If
- End With
- '生成查询结果
- Call Sub_Query
- '设置状态为修改状态
- Lab_OperStatus = "2"
- End Sub
- Private Sub Form_Unload(Cancel As Integer) '窗体卸载
- '卸载打印页面窗体
- Unload Dyymctbl
- End Sub
- Private Sub Sub_Query() '生成查询结果
- Dim SqlStr As String '查询字符串
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim Jsqte As Long '临时计数器
- SqlStr = "SELECT Cwzz_AccSumAssi.*, gy_supplier.supplier_name,Gy_Customer.CusName, Gy_Department.DeptName," & _
- " Gy_Person.PersonName , Cwzz_ViewItem.ItemName,Cwzz_ViewItem.Measure FROM Cwzz_AccSumAssi LEFT OUTER JOIN Cwzz_ViewItem ON " & _
- " Cwzz_AccSumAssi.ItemClassCode =Cwzz_ViewItem.ItemClassCode AND Cwzz_AccSumAssi.ItemCode = Cwzz_ViewItem.ItemCode LEFT OUTER JOIN " & _
- " gy_supplier ON Cwzz_AccSumAssi.Supplier_Code = gy_supplier.supplier_code LEFT OUTER JOIN Gy_Customer ON " & _
- " Cwzz_AccSumAssi.CusCode = Gy_Customer.CusCode LEFT OUTER JOIN Gy_Department ON Cwzz_AccSumAssi.DeptCode = Gy_Department.DeptCode LEFT OUTER JOIN " & _
- " Gy_Person ON Cwzz_AccSumAssi.PersonCode = Gy_Person.PersonCode WHERE Cwzz_AccSumAssi.Year = " & Int_OriYear & " And " & _
- " Cwzz_AccSumAssi.Ccode='" & Str_Ccode & "' And Cwzz_AccSumAssi.Period = 1" & _
- " Order By Cwzz_ViewItem.ItemName,Gy_Department.DeptName,Gy_Person.PersonName,Gy_Customer.CusName,gy_supplier.supplier_name"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- With RecTemp
- WglrGrid.Clear 1
- WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
- Jsqte = WglrGrid.FixedRows
- Do While Not .EOF
- If Jsqte >= WglrGrid.Rows Then
- WglrGrid.AddItem ""
- End If
- WglrGrid.TextMatrix(Jsqte, 0) = "*" '有效记录标识
- WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("I_id")) '记录唯一标识
- WglrGrid.TextMatrix(Jsqte, 2) = Trim(.Fields("ItemCode") & "") '项目编码
- WglrGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("DeptCode") & "") '部门编码
- WglrGrid.TextMatrix(Jsqte, 4) = Trim(.Fields("PersonCode") & "") '个人编码
- WglrGrid.TextMatrix(Jsqte, 5) = Trim(.Fields("CusCode") & "") '客户编码
- WglrGrid.TextMatrix(Jsqte, 6) = Trim(.Fields("Supplier_Code") & "") '供应商编码
- WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ItemName") & "") '项目名称
- WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Measure") & "") '项目单位
- WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "") '部门名称
- WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "") '个人名称
- WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("CusName") & "") '客户名称
- WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("Supplier_Name") & "") '供应商名称
- If Val(.Fields("Ycye") & "") > 0 Then '余额方向
- WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借"
- Else
- If Val(.Fields("Ycye") & "") < 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "贷"
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Str_Yefx
- End If
- End If
- '1.金额
- If Val(.Fields("Ycye") & "") <> 0 Then '年初余额
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Val(.Fields("Ycye") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = -Val(.Fields("Ycye") & "")
- End If
- End If
- If Val(.Fields("Byjfljje") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Val(.Fields("Byjfljje") & "") '本年借方累计本币金额
- End If
- If Val(.Fields("Bydfljje") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Val(.Fields("Bydfljje") & "") '本年贷方累计本币金额
- End If
- If Val(.Fields("Qmye") & "") <> 0 Then
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Val(.Fields("Qmye") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = -Val(.Fields("Qmye") & "")
- End If
- End If
- If Val(.Fields("Ycsl") & "") <> 0 Then '年初数量
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Val(.Fields("Ycsl") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = -Val(.Fields("Ycsl") & "")
- End If
- End If
- If Val(.Fields("Byjfljsl") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Val(.Fields("Byjfljsl") & "") '本年借方累计数量
- End If
- If Val(.Fields("Bydfljsl") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = Val(.Fields("Bydfljsl") & "") '本年贷方累计数量
- End If
- If Val(.Fields("Qmsl") & "") <> 0 Then '期末数量
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Val(.Fields("Qmsl") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = -Val(.Fields("Qmsl") & "")
- End If
- End If
- If Val(.Fields("Ycwb") & "") <> 0 Then '年初外币
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = Val(.Fields("Ycwb") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = -Val(.Fields("Ycwb") & "")
- End If
- End If
- If Val(.Fields("Byjfljwb") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = Val(.Fields("Byjfljwb") & "") '本年借方累计原币金额
- End If
- If Val(.Fields("Bydfljwb") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = Val(.Fields("Bydfljwb") & "") '本年贷方累计原币金额
- End If
- If Val(.Fields("Qmwb") & "") <> 0 Then '期初外币
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = Val(.Fields("Qmwb") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = -Val(.Fields("Qmwb") & "")
- End If
- End If
- If Val(.Fields("YcItemSl") & "") <> 0 Then '年初项目数量
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = Val(.Fields("YcItemSl") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = -Val(.Fields("YcItemSl") & "")
- End If
- End If
- If Val(.Fields("ItemByljjfsl") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("021", GridStr(), Szzls)) = Val(.Fields("ItemByljjfsl") & "") '本年借方累计项目数量
- End If
- If Val(.Fields("ItemByljdfsl") & "") <> 0 Then
- WglrGrid.TextMatrix(Jsqte, Sydz("022", GridStr(), Szzls)) = Val(.Fields("ItemByljdfsl") & "") '本年贷方累计项目数量
- End If
- If Val(.Fields("QmItemSl") & "") <> 0 Then '期初项目数量
- If WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = "借" Then
- WglrGrid.TextMatrix(Jsqte, Sydz("023", GridStr(), Szzls)) = Val(.Fields("QmItemSl") & "")
- Else
- WglrGrid.TextMatrix(Jsqte, Sydz("023", GridStr(), Szzls)) = -Val(.Fields("QmItemSl") & "")
- End If
- End If
- '<<]
- WglrGrid.RowHeight(Jsqte) = Sjhgd
- .MoveNext
- Jsqte = Jsqte + 1
- Loop
- End With
- '调整网格
- 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)
- End If
- Case "dy" '打 印
- If Fun_Drfrmyxxpd Then
- Call bbyl(False)
- End If
- Case "sh" '删 行
- Call Scdqfl
- Case "bz" '帮 助
- Call F1bz
- Case "fh" '退 出
- Unload Me
- End Select
- '解 锁
- Valilock = False
- changelock = False
- End Sub
- Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) '支持热键操作
- If Shift = 2 Then
- Select Case UCase(Chr(KeyCode))
- Case "P" 'Ctrl+P 打印
- If Tlb_Action.Buttons("dy").Enabled Then
- Call bbyl(False)
- End If
- End Select
- 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) '录入数据字段有效性判断,同时进行字段录入事后处理
- Dim Str_JudgeText As String '临时有效性判断字段内容
- Dim Coljsq As Long '临时列计数器
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim Dbl_Qcye As Double '临时期初余额
- 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)
- '以下为自定义部分[
- '1.放置字段有效性判断程序
- Case "001" '项目(如有效则调入项目编码)
- If Len(Str_JudgeText) <> 0 Then
- SqlStr = "Select * FROM Cwzz_Item Where ItemClassCode='" & Str_ItemClassCode & "' And (ItemCode='" & Str_JudgeText & "' OR ItemName='" & Str_JudgeText & "')"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- With RecTemp
- If .EOF Then
- Tsxx = "此核算项目不存在!"
- GoTo Lrcwcl
- End If
- '1.如果核算项目存在则存储相应核算项目编码
- WglrGrid.TextMatrix(Dqpdwgh, 2) = Trim(RecTemp.Fields("ItemCode"))
- WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("ItemName"))
- End With
- Else
- WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""
- End If
- Case "003" '部门(如有效则调入部门编码)
- If Len(Str_JudgeText) <> 0 Then
- SqlStr = "Select DeptCode,DeptName,StopUse FROM Gy_Department Where DeptCode='" & Str_JudgeText & "' OR DeptName='" & Str_JudgeText & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- With RecTemp
- If .EOF Then
- Tsxx = "此部门不存在!"
- GoTo Lrcwcl
- Else
- If .Fields("StopUse") Then
- Tsxx = "此部门已停用"
- GoTo Lrcwcl
- End If
- End If
- '1.如果部门存在则存储相应部门编码
- WglrGrid.TextMatrix(Dqpdwgh, 3) = Trim(RecTemp.Fields("DeptCode"))
- WglrGrid.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptName"))
- End With
- End If
- Case "004" '往来个人(如有效则调入个人编码)
- If Len(Str_JudgeText) <> 0 Then
- SqlStr = "Select PerSonCode,PerSonName,DeptCode FROM Gy_PerSon Where PerSonCode='" & Str_JudgeText & "' OR PerSonName='" & Str_JudgeText & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- With RecTemp
- If .EOF Then
- Tsxx = "此往来个人不存在!"
- GoTo Lrcwcl
- End If
- '1.如果个人存在则存储相应个人编码,部门编码
- WglrGrid.TextMatrix(Dqpdwgh, 3) = Trim(RecTemp.Fields("DeptCode"))
- WglrGrid.TextMatrix(Dqpdwgh, 4) = Trim(RecTemp.Fields("PerSonCode"))
- WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("PerSonName"))
- End With
- End If
- Case "005" '往来客户(如有效则调入客户编码)
- If Len(Str_JudgeText) <> 0 Then
- SqlStr = "Select CusCode,CusName,StopUse FROM Gy_Customer Where CusCode='" & Str_JudgeText & "' OR CusName='" & Str_JudgeText & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- With RecTemp
- If .EOF Then
- Tsxx = "此往来客户不存在!"
- GoTo Lrcwcl
- Else
- If .Fields("StopUse") Then
- Tsxx = "此客户已停用!"
- GoTo Lrcwcl
- End If
- End If
- '1.如果客户存在则存储相应客户编码
- WglrGrid.TextMatrix(Dqpdwgh, 5) = Trim(RecTemp.Fields("CusCode"))
- WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("CusName"))
- End With
- End If
- Case "006" '往来供应商(如有效则调入供应商编码)
- If Len(Str_JudgeText) <> 0 Then
- SqlStr = "Select Supplier_Code,Supplier_Name,StopUse FROM Gy_Supplier Where Supplier_Code='" & Str_JudgeText & "' OR Supplier_Name='" & Str_JudgeText & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- With RecTemp
- If .EOF Then
- Tsxx = "此往来供应商不存在!"
- GoTo Lrcwcl
- Else
- If .Fields("StopUse") Then
- Tsxx = "此供应商已停用!"
- GoTo Lrcwcl
- End If
- End If
- '1.如果供应商存在则存储相应供应商编码
- WglrGrid.TextMatrix(Dqpdwgh, 6) = Trim(RecTemp.Fields("Supplier_Code"))
- WglrGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Trim(RecTemp.Fields("Supplier_Name"))
- End With
- End If
- Case "007", "008", "009", "010" '年初方向,年初余额,累计借方,累计贷方(本币)
- If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
- Else
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
- End If
- If Dbl_Qcye = 0 Then
- .TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls)) = ""
- Else
- .TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls)) = Dbl_Qcye
- End If
- Case "007", "012", "013", "014" '年初方向,年初余额,累计借方,累计贷方(数量)
- If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("012", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("014", GridStr(), Szzls)))
- Else
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("012", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("014", GridStr(), Szzls)))
- End If
- If Dbl_Qcye = 0 Then
- .TextMatrix(Dqpdwgh, Sydz("015", GridStr(), Szzls)) = ""
- Else
- .TextMatrix(Dqpdwgh, Sydz("015", GridStr(), Szzls)) = Dbl_Qcye
- End If
- Case "007", "016", "017", "018" '年初方向,年初余额,累计借方,累计贷方(原币)
- If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("016", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("017", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("018", GridStr(), Szzls)))
- Else
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("016", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("017", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("018", GridStr(), Szzls)))
- End If
- If Dbl_Qcye = 0 Then
- .TextMatrix(Dqpdwgh, Sydz("019", GridStr(), Szzls)) = ""
- Else
- .TextMatrix(Dqpdwgh, Sydz("019", GridStr(), Szzls)) = Dbl_Qcye
- End If
- Case "007", "020", "021", "022" '年初方向,年初余额,累计借方,累计贷方(项目数量)
- If .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = "借" Then
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("020", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("021", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("022", GridStr(), Szzls)))
- Else
- Dbl_Qcye = Val(.TextMatrix(Dqpdwgh, Sydz("020", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("021", GridStr(), Szzls))) + Val(.TextMatrix(Dqpdwgh, Sydz("022", GridStr(), Szzls)))
- End If
- If Dbl_Qcye = 0 Then
- .TextMatrix(Dqpdwgh, Sydz("023", GridStr(), Szzls)) = ""
- Else
- .TextMatrix(Dqpdwgh, Sydz("023", GridStr(), Szzls)) = Dbl_Qcye
- End If
- '2.放置字段事后处理程序
- '以上为自定义部分]
- 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 SqlStr As String '临时连接字符串
- Dim Rec_AccSumAssi As New ADODB.Recordset '辅助总帐动态集
- Dim Dbl_Now(1 To 16) As Double '科目记录现数据
- Dim Str_OriItemCode As String '辅助核算项目编码(原)
- Dim Str_NowItemCode As String '辅助核算项目编码(现)
- 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 And Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Or (GridInt(Jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Then
- Tsxx = GridStr(Jsqte, 2)
- Lrywlz = Jsqte
- GoTo Lrcwcl
- Exit For
- End If
- Next Jsqte
- '科目所要进行核算项不能为空
- If (Not .ColHidden(Sydz("001", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls))) = "" Then
- Tsxx = "核算项目不能为空!"
- Lrywlz = Sydz("001", GridStr(), Szzls)
- GoTo Lrcwcl
- End If
- If (Not .ColHidden(Sydz("003", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls))) = "" Then
- Tsxx = "部门不能为空!"
- Lrywlz = Sydz("003", GridStr(), Szzls)
- GoTo Lrcwcl
- End If
- If (Not .ColHidden(Sydz("004", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls))) = "" Then
- Tsxx = "往来个人不能为空!"
- Lrywlz = Sydz("004", GridStr(), Szzls)
- GoTo Lrcwcl
- End If
- If (Not .ColHidden(Sydz("005", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls))) = "" Then
- Tsxx = "往来客户不能为空!"
- Lrywlz = Sydz("005", GridStr(), Szzls)
- GoTo Lrcwcl
- End If
- If (Not .ColHidden(Sydz("006", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls))) = "" Then
- Tsxx = "往来供应商不能为空!"
- Lrywlz = Sydz("006", GridStr(), Szzls)
- GoTo Lrcwcl
- End If
- '如果项目核算单位为空则清空项目核算数量
- If Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls))) = "" Then
- WglrGrid.TextMatrix(Yxxpdh, Sydz("020", GridStr(), Szzls)) = ""
- WglrGrid.TextMatrix(Yxxpdh, Sydz("021", GridStr(), Szzls)) = ""
- WglrGrid.TextMatrix(Yxxpdh, Sydz("022", GridStr(), Szzls)) = ""
- WglrGrid.TextMatrix(Yxxpdh, Sydz("023", GridStr(), Szzls)) = ""
- End If
- '判断记录是否重复
- SqlStr = "SELECT Cwzz_AccSumAssi.I_id From Cwzz_AccSumAssi WHERE Ccode='" & Str_Ccode & "'And ItemClassCode='" & Str_ItemClassCode & _
- "'And ItemCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 2)) & "'And DeptCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) & "'And PersonCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 4)) & _
- "'And CusCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 5)) & "'And Supplier_Code='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 6)) & _
- "' And Year=" & Int_OriYear & " And Period =1"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- If Not RecTemp.EOF Then
- If RecTemp.Fields("I_ID") <> Val(WglrGrid.TextMatrix(Yxxpdh, 1)) Then
- Tsxx = "录入记录重复!"
- For Jsqte = Qslz To WglrGrid.Cols - 1
- If Not WglrGrid.ColHidden(Jsqte) Then
- Lrywlz = Jsqte
- End If
- Next Jsqte
- GoTo Lrcwcl
- End If
- End If
- '2.进行行数据回写
- If WglrGrid.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)) = "借" Then
- Dbl_Now(1) = Val(.TextMatrix(Yxxpdh, Sydz("008", GridStr(), Szzls))) '年初余额
- Dbl_Now(2) = Val(.TextMatrix(Yxxpdh, Sydz("009", GridStr(), Szzls))) '本年借方累计金额
- Dbl_Now(3) = Val(.TextMatrix(Yxxpdh, Sydz("010", GridStr(), Szzls))) '本年贷方累计金额
- Dbl_Now(4) = Val(.TextMatrix(Yxxpdh, Sydz("011", GridStr(), Szzls))) '期末余额
- Dbl_Now(5) = Val(.TextMatrix(Yxxpdh, Sydz("012", GridStr(), Szzls))) '年初数量
- Dbl_Now(6) = Val(.TextMatrix(Yxxpdh, Sydz("013", GridStr(), Szzls))) '本年借方累计数量
- Dbl_Now(7) = Val(.TextMatrix(Yxxpdh, Sydz("014", GridStr(), Szzls))) '本年贷方累计金额
- Dbl_Now(8) = Val(.TextMatrix(Yxxpdh, Sydz("015", GridStr(), Szzls))) '期末数量
- Dbl_Now(9) = Val(.TextMatrix(Yxxpdh, Sydz("016", GridStr(), Szzls))) '年初外币
- Dbl_Now(10) = Val(.TextMatrix(Yxxpdh, Sydz("017", GridStr(), Szzls))) '本年借方累计外币
- Dbl_Now(11) = Val(.TextMatrix(Yxxpdh, Sydz("018", GridStr(), Szzls))) '本年贷方累计外币
- Dbl_Now(12) = Val(.TextMatrix(Yxxpdh, Sydz("019", GridStr(), Szzls))) '期末余额
- Dbl_Now(13) = Val(.TextMatrix(Yxxpdh, Sydz("020", GridStr(), Szzls))) '年初项目数量
- Dbl_Now(14) = Val(.TextMatrix(Yxxpdh, Sydz("021", GridStr(), Szzls))) '本年借方累计项目数量
- Dbl_Now(15) = Val(.TextMatrix(Yxxpdh, Sydz("022", GridStr(), Szzls))) '本年贷方累计项目数量
- Dbl_Now(16) = Val(.TextMatrix(Yxxpdh, Sydz("023", GridStr(), Szzls))) '期末项目数量
- Else
- Dbl_Now(1) = -Val(.TextMatrix(Yxxpdh, Sydz("008", GridStr(), Szzls))) '年初余额
- Dbl_Now(2) = Val(.TextMatrix(Yxxpdh, Sydz("009", GridStr(), Szzls))) '本年借方累计金额
- Dbl_Now(3) = Val(.TextMatrix(Yxxpdh, Sydz("010", GridStr(), Szzls))) '本年贷方累计金额
- Dbl_Now(4) = -Val(.TextMatrix(Yxxpdh, Sydz("011", GridStr(), Szzls))) '期末余额
- Dbl_Now(5) = -Val(.TextMatrix(Yxxpdh, Sydz("012", GridStr(), Szzls))) '年初数量
- Dbl_Now(6) = Val(.TextMatrix(Yxxpdh, Sydz("013", GridStr(), Szzls))) '本年借方累计数量
- Dbl_Now(7) = Val(.TextMatrix(Yxxpdh, Sydz("014", GridStr(), Szzls))) '本年贷方累计金额
- Dbl_Now(8) = -Val(.TextMatrix(Yxxpdh, Sydz("015", GridStr(), Szzls))) '期末数量
- Dbl_Now(9) = -Val(.TextMatrix(Yxxpdh, Sydz("016", GridStr(), Szzls))) '年初外币
- Dbl_Now(10) = Val(.TextMatrix(Yxxpdh, Sydz("017", GridStr(), Szzls))) '本年借方累计外币
- Dbl_Now(11) = Val(.TextMatrix(Yxxpdh, Sydz("018", GridStr(), Szzls))) '本年贷方累计外币
- Dbl_Now(12) = -Val(.TextMatrix(Yxxpdh, Sydz("019", GridStr(), Szzls))) '期末余额
- Dbl_Now(13) = -Val(.TextMatrix(Yxxpdh, Sydz("020", GridStr(), Szzls))) '年初项目数量
- Dbl_Now(14) = Val(.TextMatrix(Yxxpdh, Sydz("021", GridStr(), Szzls))) '本年借方累计项目数量
- Dbl_Now(15) = Val(.TextMatrix(Yxxpdh, Sydz("022", GridStr(), Szzls))) '本年贷方累计项目数量
- Dbl_Now(16) = -Val(.TextMatrix(Yxxpdh, Sydz("023", GridStr(), Szzls))) '期末项目数量
- End If
- End With
- On Error GoTo Swcwcl
- Cw_DataEnvi.DataConnect.BeginTrans
- With Rec_AccSumAssi
- If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
- If .State = 1 Then .Close
- .Open "SELECT Cwzz_AccSumAssi.* From Cwzz_AccSumAssi WHERE I_id = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- If Not .EOF Then
- .Fields("Ccode") = Str_Ccode '核算科目
- .Fields("ItemClassCode") = Str_ItemClassCode '项目类别
- .Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 2)) '现辅助核算项目编码
- .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) '现辅助核算部门编码
- .Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 4)) '现辅助核算个人编码
- .Fields("CusCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 5)) '现辅助核算客户编码
- .Fields("Supplier_Code") = Trim(WglrGrid.TextMatrix(Yxxpdh, 6)) '现辅助核算供应商编码
- .Fields("Year") = Int_OriYear '会计年度
- .Fields("Period") = 1 '会计期间
- .Fields("Ycye") = Dbl_Now(1) '年初余额
- .Fields("Qcye") = Dbl_Now(1) '期初余额
- .Fields("Mjje") = Dbl_Now(2) '本月借方金额合计
- .Fields("Mdje") = Dbl_Now(3) '本月贷方金额合计
- .Fields("Byjfljje") = Dbl_Now(2) '本年借方金额合计
- .Fields("Bydfljje") = Dbl_Now(3) '本年贷方金额合计
- .Fields("Qmye") = Dbl_Now(4) '期末余额
- .Fields("Ycsl") = Dbl_Now(5) '年初数量
- .Fields("Qcsl") = Dbl_Now(5) '期初数量
- .Fields("Mjsl") = Dbl_Now(6) '本月借方数量合计
- .Fields("Mdsl") = Dbl_Now(7) '本月贷方数量合计
- .Fields("Byjfljsl") = Dbl_Now(6) '本年借方数量合计
- .Fields("Bydfljsl") = Dbl_Now(7) '本年贷方数量合计
- .Fields("Qmsl") = Dbl_Now(8) '期末数量
- .Fields("YcItemsl") = Dbl_Now(13) '年初项目数量
- .Fields("QcItemsl") = Dbl_Now(13) '期初数量
- .Fields("ItemMjsl") = Dbl_Now(14) '本月借方数量合计
- .Fields("ItemMdsl") = Dbl_Now(15) '本月贷方数量合计
- .Fields("ItemByljjfsl") = Dbl_Now(14) '本年借方数量合计
- .Fields("ItemByljdfsl") = Dbl_Now(15) '本年贷方数量合计
- .Fields("QmItemsl") = Dbl_Now(16) '期末项目数量
- '如为外币核算则用外币录入金额替换,否则填入本位币金额
- If Bln_Foreign Then
- .Fields("Ycwb") = Dbl_Now(9) '年初原币
- .Fields("Qcwb") = Dbl_Now(9) '期初原币
- .Fields("Mjwb") = Dbl_Now(10) '本月借方原币合计
- .Fields("Mdwb") = Dbl_Now(11) '本月贷方原币合计
- .Fields("Byjfljwb") = Dbl_Now(10) '本年借方原币合计
- .Fields("Bydfljwb") = Dbl_Now(11) '本年贷方原币合计
- .Fields("Qmwb") = Dbl_Now(12) '期末原币
- Else
- .Fields("Ycwb") = Dbl_Now(1) '年初原币
- .Fields("Qcwb") = Dbl_Now(1) '期初原币
- .Fields("Mjwb") = Dbl_Now(2) '本月借方原币合计
- .Fields("Mdwb") = Dbl_Now(3) '本月贷方原币合计
- .Fields("Byjfljwb") = Dbl_Now(2) '本年借方原币合计
- .Fields("Bydfljwb") = Dbl_Now(3) '本年贷方原币合计
- .Fields("Qmwb") = Dbl_Now(4) '期末原币
- End If
- .Update
- '更新其他各会计期间数据
- SqlStr = "Update Cwzz_AccSumAssi Set Ycye=" & .Fields("Ycye") & ",Qcye=" & .Fields("Qmye") & ",Byjfljje=" & .Fields("Byjfljje") & ",Bydfljje=" & .Fields("Bydfljje") & ",Qmye=" & .Fields("Qmye") & _
- ",Ycsl=" & .Fields("Ycsl") + 0 & ",Qcsl=" & .Fields("Qmsl") + 0 & ",Byjfljsl=" & .Fields("Byjfljsl") + 0 & ",Bydfljsl=" & .Fields("Bydfljsl") + 0 & ",Qmsl=" & .Fields("Qmsl") + 0 & _
- ",Ycwb=" & .Fields("Ycwb") + 0 & ",Qcwb=" & .Fields("Qmwb") + 0 & ",Byjfljwb=" & .Fields("Byjfljwb") + 0 & ",Bydfljwb=" & .Fields("Bydfljwb") + 0 & ",Qmwb=" & .Fields("Qmwb") + 0 & _
- ",YcItemSl=" & .Fields("YcItemSl") + 0 & ",QcItemSl=" & .Fields("QcItemSl") + 0 & ",ItemByljjfsl=" & .Fields("ItemByljjfsl") + 0 & ",ItemByljdfsl=" & .Fields("ItemByljdfsl") + 0 & ",QmItemSl=" & .Fields("QmItemSl") + 0 & _
- " Where Ccode='" & Str_Ccode & "'And ItemClassCode='" & Str_ItemClassCode & "'And ItemCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 2)) & "'And DeptCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) & "'And PersonCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 4)) & "'And CusCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 5)) & "'And Supplier_Code='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 6)) & _
- "'And DeptCode='" & .Fields("DeptCode") & "' And Year=" & Int_OriYear & " And Period >1"
- Cw_DataEnvi.DataConnect.Execute (SqlStr)
- End If
- Else
- If .State = 1 Then .Close
- .Open "SELECT Cwzz_AccSumAssi.* From Cwzz_AccSumAssi Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
- .AddNew
- .Fields("Ccode") = Str_Ccode '核算科目
- .Fields("ItemClassCode") = Str_ItemClassCode '项目类别
- .Fields("ItemCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 2)) '现辅助核算项目编码
- .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) '现辅助核算部门编码
- .Fields("PersonCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 4)) '现辅助核算个人编码
- .Fields("CusCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 5)) '现辅助核算客户编码
- .Fields("Supplier_Code") = Trim(WglrGrid.TextMatrix(Yxxpdh, 6)) '现辅助核算供应商编码
- .Fields("Year") = Int_OriYear '会计年度
- .Fields("Period") = 1 '会计期间
- .Fields("Ycye") = Dbl_Now(1) '年初余额
- .Fields("Qcye") = Dbl_Now(1) '期初余额
- .Fields("Mjje") = Dbl_Now(2) '本月借方金额合计
- .Fields("Mdje") = Dbl_Now(3) '本月贷方金额合计
- .Fields("Byjfljje") = Dbl_Now(2) '本月借方金额合计
- .Fields("Bydfljje") = Dbl_Now(3) '本月贷方金额合计
- .Fields("Qmye") = Dbl_Now(4) '期末余额
- .Fields("Ycsl") = Dbl_Now(5) '年初数量
- .Fields("Qcsl") = Dbl_Now(5) '期初数量
- .Fields("Mjsl") = Dbl_Now(6) '本月借方数量合计
- .Fields("Mdsl") = Dbl_Now(7) '本月贷方数量合计
- .Fields("Byjfljsl") = Dbl_Now(6) '本年借方数量累计
- .Fields("Bydfljsl") = Dbl_Now(7) '本年贷方数量累计
- .Fields("Qmsl") = Dbl_Now(8) '期末数量
- .Fields("YcItemsl") = Dbl_Now(13) '年初项目数量
- .Fields("QcItemsl") = Dbl_Now(13) '期初数量
- .Fields("ItemMjsl") = Dbl_Now(14) '本月借方数量合计
- .Fields("ItemMdsl") = Dbl_Now(15) '本月贷方数量合计
- .Fields("ItemByljjfsl") = Dbl_Now(14) '本年借方数量累计
- .Fields("ItemByljdfsl") = Dbl_Now(15) '本年贷方数量累计
- .Fields("QmItemsl") = Dbl_Now(16) '期末项目数量
- '如为外币核算则用外币录入金额替换,否则填入本位币金额
- If Bln_Foreign Then
- .Fields("Ycwb") = Dbl_Now(9) '年初原币
- .Fields("Qcwb") = Dbl_Now(9) '期初原币
- .Fields("Mjwb") = Dbl_Now(10) '本月借方原币合计
- .Fields("Mdwb") = Dbl_Now(11) '本月贷方原币合计
- .Fields("Byjfljwb") = Dbl_Now(10) '本年借方原币累计
- .Fields("Bydfljwb") = Dbl_Now(11) '本年贷方原币累计
- .Fields("Qmwb") = Dbl_Now(12) '期末原币
- Else
- .Fields("Ycwb") = Dbl_Now(1) '年初原币
- .Fields("Qcwb") = Dbl_Now(1) '期初原币
- .Fields("Mjwb") = Dbl_Now(2) '本月借方原币合计
- .Fields("Mdwb") = Dbl_Now(3) '本月贷方原币合计
- .Fields("Byjfljwb") = Dbl_Now(2) '本年借方原币累计
- .Fields("Bydfljwb") = Dbl_Now(3) '本年贷方原币累计
- .Fields("Qmwb") = Dbl_Now(4) '期末原币
- End If
- .Update
- WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("I_id")
- '添加并更新其他会计期间数据(按12个会计期间)
- For Int_PeriodTe = 1 To 12
- If Int_PeriodTe <> 1 Then
- SqlStr = "Insert Into Cwzz_AccSumAssi (Ccode,Year,Period,ItemClassCode,ItemCode,DeptCode,PersonCode,CusCode,Supplier_Code) values ('" & Str_Ccode & "'," & Int_OriYear & "," & Int_PeriodTe & ",'" & Str_ItemClassCode & "','" & Trim(WglrGrid.TextMatrix(Yxxpdh, 2)) & "','" & Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) & "','" & Trim(WglrGrid.TextMatrix(Yxxpdh, 4)) & "','" & Trim(WglrGrid.TextMatrix(Yxxpdh, 5)) & "','" & Trim(WglrGrid.TextMatrix(Yxxpdh, 6)) & "')"
- Cw_DataEnvi.DataConnect.Execute (SqlStr)
- End If
- Next Int_PeriodTe
- '更新其他各会计期间数据
- SqlStr = "Update Cwzz_AccSumAssi Set Ycye=" & .Fields("Ycye") & ",Qcye=" & .Fields("Qmye") & ",Byjfljje=" & .Fields("Byjfljje") & ",Bydfljje=" & .Fields("Bydfljje") & ",Qmye=" & .Fields("Qmye") & _
- ",Ycsl=" & .Fields("Ycsl") + 0 & ",Qcsl=" & .Fields("Qmsl") + 0 & ",Byjfljsl=" & .Fields("Byjfljsl") + 0 & ",Bydfljsl=" & .Fields("Bydfljsl") + 0 & ",Qmsl=" & .Fields("Qmsl") + 0 & _
- ",Ycwb=" & .Fields("Ycwb") + 0 & ",Qcwb=" & .Fields("Qmwb") + 0 & ",Byjfljwb=" & .Fields("Byjfljwb") + 0 & ",Bydfljwb=" & .Fields("Bydfljwb") + 0 & ",Qmwb=" & .Fields("Qmwb") + 0 & _
- ",YcItemSl=" & .Fields("YcItemSl") + 0 & ",QcItemSl=" & .Fields("QcItemSl") + 0 & ",ItemByljjfsl=" & .Fields("ItemByljjfsl") + 0 & ",ItemByljdfsl=" & .Fields("ItemByljdfsl") + 0 & ",QmItemSl=" & .Fields("QmItemSl") + 0 & _
- " Where Ccode='" & Str_Ccode & "'And ItemClassCode='" & Str_ItemClassCode & "'And ItemCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 2)) & "'And DeptCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) & "'And PersonCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 4)) & "'And CusCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 5)) & "'And Supplier_Code='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 6)) & _
- "'And DeptCode='" & .Fields("DeptCode") & "' And Year=" & Int_OriYear & " And Period >1"
- Cw_DataEnvi.DataConnect.Execute (SqlStr)
- End If
- End With
- Cw_DataEnvi.DataConnect.CommitTrans
- ' <<]
- '以上为自定义部分]
- Sjhzyxxpd = True
- Hyxxpdlock = True
- Exit Function
- Swcwcl:
- Cw_DataEnvi.DataConnect.RollbackTrans
- Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
- Call Xtxxts(Tsxx, 0, 1)
- 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_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
- Else
- '判断是否有辅助行和录入行,如没有则加行
- Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
- .AddItem ""
- .RowHeight(.Rows - 1) = Sjhgd
- Loop
- End If
- End With
- End Sub
- Private Sub Lrzdbz() '录入字段帮助
- If Not YdCommand.Visible Then
- Exit Sub
- End If
- Valilock = True
- With WglrGrid
- changelock = True '调入另外窗体必须加锁
- If .Col = Sydz("001", GridStr(), Szzls) Then
- Xtcdcs = Trim(Ydtext.Text)
- Xtcdcsfz = Str_ItemClassCode
- XT_ItemHelp.Show 1
- Else
- Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
- End If
- 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 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_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
- 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
- Select Case GridInt(.Col, 1)
- Case 8
- Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
- Case 9
- 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 Trim(Lab_OperStatus.Caption) = "1" 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
- 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 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 vbKeyDelete '删行
- Call Scdqfl
- Case vbKeyInsert '增行
- Call zjlrfl
- End Select
- End Sub
- Private Sub WglrGrid_KeyPress(KeyAscii As Integer) '网格接受键盘录入
- Dim Str_ChangeTe As String '临时交换内容
- Dim Coljsq As Long '临时列计数器
- Dim Int_SaveKey As Integer '保存KeyAscii值
- '如果单据操作状态为浏览状态则不能显示录入载体
- If Trim(Lab_OperStatus.Caption) = "1" Then
- Exit Sub
- End If
- Int_SaveKey = KeyAscii
- 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
- '显示录入载体
- 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), wait
- 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
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim SqlStr As String '临时连接字符串
- Dim Str_NowItemCode As String '辅助核算项目编码(现)
- 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
- On Error GoTo Swcwcl
- Cw_DataEnvi.DataConnect.BeginTrans
- If Val(WglrGrid.TextMatrix(.Row, 1)) <> 0 Then
- SqlStr = "SELECT Cwzz_AccSumAssi.ItemClassCode,ItemCode,PersonCode,DeptCode,CusCode,Supplier_Code From Cwzz_AccSumAssi WHERE I_id=" & Val(WglrGrid.TextMatrix(.Row, 1))
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
- If Not RecTemp.EOF Then
- SqlStr = "Delete Cwzz_AccSumAssi Where Ccode='" & Str_Ccode & "'And ItemClassCode='" & Trim(RecTemp.Fields("ItemClassCode")) & "'And ItemCode='" & Trim(RecTemp.Fields("ItemCode")) & _
- "'And PersonCode='" & Trim(RecTemp.Fields("PersonCode")) & "'And DeptCode='" & Trim(RecTemp.Fields("DeptCode")) & "'And CusCode='" & Trim(RecTemp.Fields("CusCode")) & "'And Supplier_Code='" & Trim(RecTemp.Fields("Supplier_Code")) & "' And Year=" & Int_OriYear
- Cw_DataEnvi.DataConnect.Execute (SqlStr)
- End If
- End If
- Cw_DataEnvi.DataConnect.CommitTrans
- .RemoveItem .Row
- If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
- .AddItem ""
- .RowHeight(.Rows - 1) = Sjhgd
- End If
- changelock = True
- .Select .Row, Scqwglz
- changelock = False
- End If
- End With
- Exit Sub
- '[>>事务错误处理
- Swcwcl:
- Cw_DataEnvi.DataConnect.RollbackTrans
- txss = "删除过程中出现错误!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- '<<]
- End Sub
- Private Sub Qkwlzd(sjh As Long, Sjl As Long) '清空为零字段
- If Not GridBoolean(Sjl, 5) Then
- Exit Sub
- End If
- With WglrGrid
- If Val(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
- .TopRow = .TopRow - 1
- Loop
- End With
- End Sub
- Private Sub Xldql() '显露当前列
- Dim Leftcolte As Long
- With WglrGrid
- If .Col >= Qslz 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 GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '表格格式设置(通用)
- Select Case Button.Key
- Case "bcgs" '保存表格格式
- Call Bcwggs(WglrGrid, GridCode, GridStr())
- Case "hfmrgs" '恢复默认格式
- Call Hfmrgs(WglrGrid, GridCode, GridStr())
- End Select
- 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 = 0 '报 表 表 尾 行 数
- 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
- 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
