企业管理

开发平台：

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 CL_PzFrm
BackColor = &H00E9F4FA&
BorderStyle = 1 'Fixed Single
Caption = "记帐凭证"
ClientHeight = 6720
ClientLeft = 675
ClientTop = 720
ClientWidth = 10515
HelpContextID = 130407
Icon = "处理_凭证处理.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form4"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6720
ScaleWidth = 10515
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton Ydcommand1
Height = 300
Left = 6930
Picture = "处理_凭证处理.frx":1042
Style = 1 'Graphical
TabIndex = 6
Top = 1110
Visible = 0 'False
Width = 300
End
Begin VB.CommandButton Ydcommand
Height = 300
Left = 6600
Picture = "处理_凭证处理.frx":13CC
Style = 1 'Graphical
TabIndex = 7
Top = 1110
Visible = 0 'False
Width = 300
End
Begin VB.Frame Frame1
BackColor = &H00E9F4FA&
Height = 855
Left = 150
TabIndex = 19
Top = 5400
Width = 10215
Begin VB.Label Lab_Memo
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00E9F4FA&
BorderStyle = 1 'Fixed Single
Caption = "备注"
ForeColor = &H80000008&
Height = 675
Index = 1
Left = 30
TabIndex = 21
Top = 120
Width = 285
WordWrap = -1 'True
End
Begin VB.Label Lab_Memo
Appearance = 0 'Flat
BackColor = &H00E9F4FA&
BorderStyle = 1 'Fixed Single
ForeColor = &H00FF0000&
Height = 675
Index = 0
Left = 330
TabIndex = 20
Top = 120
Width = 9825
End
End
Begin VB.ComboBox YdCombo
Height = 315
Left = 6570
Style = 2 'Dropdown List
TabIndex = 15
Top = 540
Visible = 0 'False
Width = 1155
End
Begin VB.TextBox LrText
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 300
Index = 1
Left = 5280
TabIndex = 14
Text = "1"
Top = 1320
Width = 1155
End
Begin VB.TextBox LrText
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 300
Index = 0
Left = 1530
TabIndex = 13
Text = "0"
Top = 1320
Width = 450
End
Begin VB.TextBox LrText
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 300
Index = 2
Left = 8700
TabIndex = 12
Text = "2"
Top = 1320
Width = 1095
End
Begin VB.TextBox LrText
Appearance = 0 'Flat
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 300
Index = 3
Left = 2250
TabIndex = 11
Text = "3"
Top = 1320
Width = 795
End
Begin VB.CheckBox Chk_Quantity
BackColor = &H00C9ECFE&
Caption = "科目数量核算则数量不能为零"
Height = 285
Left = 6330
TabIndex = 10
Top = 3330
Value = 1 'Checked
Visible = 0 'False
Width = 2685
End
Begin VB.CheckBox Chk_DeleteMess
BackColor = &H00C9ECFE&
Caption = "删除会计分录是否提示"
Height = 285
Left = 6330
TabIndex = 9
Top = 3030
Value = 1 'Checked
Visible = 0 'False
Width = 2685
End
Begin VB.TextBox Ydtext
BackColor = &H00C0FFFF&
BorderStyle = 0 'None
Height = 270
Left = 2250
MultiLine = -1 'True
TabIndex = 8
Top = 960
Visible = 0 'False
Width = 1185
End
Begin VB.Timer Timer1
Interval = 1
Left = 7230
Top = 840
End
Begin VB.ComboBox Combo_Kjqj
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 300
Left = 8700
Style = 1 'Simple Combo
TabIndex = 5
Text = "Combo_Kjqj"
Top = 960
Width = 1095
End
Begin VSFlex8Ctl.VSFlexGrid WglrGrid
Height = 3795
Left = 120
TabIndex = 16
Top = 1710
Width = 10260
_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 = -2147483643
ForeColor = -2147483640
BackColorFixed = 12640511
ForeColorFixed = -2147483630
BackColorSel = -2147483643
ForeColorSel = -2147483640
BackColorBkg = -2147483632
BackColorAlternate= -2147483643
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 = 2
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
AutoSearchDelay = 2
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 0
ShowComboButton = 1
WordWrap = -1 'True
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
DataMember = ""
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 0
BackColorFrozen = 0
ForeColorFrozen = 0
WallPaperAlignment= 9
AccessibleName = ""
AccessibleDescription= ""
AccessibleValue = ""
AccessibleRole = 24
Begin VB.CheckBox Chk_CodeOutput
BackColor = &H00C9ECFE&
Caption = "打印凭证是否输出科目编码"
Height = 255
Left = 6060
TabIndex = 17
Top = 1740
Visible = 0 'False
Width = 2685
End
Begin VSFlex8Ctl.VSFlexGrid HjGrid
Height = 555
Left = 0
TabIndex = 18
Top = 3270
Width = 7545
_cx = 5080
_cy = 5080
Appearance = 1
BorderStyle = 0
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = 15332602
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483643
ForeColorSel = -2147483640
BackColorBkg = -2147483632
BackColorAlternate= 15332602
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
AutoSearchDelay = 2
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 0
ShowComboButton = 1
WordWrap = -1 'True
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
DataMember = ""
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 0
BackColorFrozen = 0
ForeColorFrozen = 0
WallPaperAlignment= 9
AccessibleName = ""
AccessibleDescription= ""
AccessibleValue = ""
AccessibleRole = 24
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 9960
Top = 660
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 18
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
EndProperty
End
Begin MSComctlLib.Toolbar Tlb_Action
Align = 1 'Align Top
Height = 555
Left = 0
TabIndex = 22
Top = 0
Width = 10515
_ExtentX = 18547
_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 = 19
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "设置"
Key = "ymsz"
Object.ToolTipText = "打印页面设置"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打印"
Key = "dy"
Object.ToolTipText = "打印当前单据或Ctrl+P"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "预览"
Key = "yl"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Object.Visible = 0 'False
Caption = "增行"
Key = "zh"
Object.ToolTipText = "插入一行或Insert"
ImageIndex = 5
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Object.Visible = 0 'False
Caption = "删行"
Key = "sh"
Object.ToolTipText = "删除当前记录行或Delete"
ImageIndex = 6
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Object.Visible = 0 'False
Key = "fgh1"
Style = 3
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保存"
Key = "bc"
Object.ToolTipText = "保存单据或F6"
ImageIndex = 7
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "放弃"
Key = "fq"
Object.ToolTipText = "放弃此次操作"
ImageIndex = 8
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "fgh2"
Style = 3
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "首张"
Key = "first"
ImageIndex = 14
EndProperty
BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "上张"
Key = "prev"
ImageIndex = 15
EndProperty
BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "下张"
Key = "next"
ImageIndex = 16
EndProperty
BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "末张"
Key = "last"
ImageIndex = 17
EndProperty
BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "fgh5"
ImageIndex = 18
Style = 3
EndProperty
BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Object.Visible = 0 'False
Caption = "选项"
Key = "xx"
ImageIndex = 18
EndProperty
BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Object.Visible = 0 'False
Style = 3
EndProperty
BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
Key = "bz"
ImageIndex = 9
EndProperty
BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "fh"
ImageIndex = 10
EndProperty
EndProperty
BorderStyle = 1
End
Begin VB.Label TsLabel
BackColor = &H80000018&
BackStyle = 0 'Transparent
Caption = "记帐凭证"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 330
Index = 4
Left = 4290
TabIndex = 49
Top = 720
Width = 2115
End
Begin VB.Line Line1
BorderColor = &H00000000&
Index = 1
X1 = 3930
X2 = 6270
Y1 = 1080
Y2 = 1080
End
Begin VB.Line Line1
BorderColor = &H00000000&
Index = 0
X1 = 3945
X2 = 6270
Y1 = 1035
Y2 = 1035
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "制单日期"
Height = 255
Index = 1
Left = 4470
TabIndex = 48
Top = 1380
Width = 825
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "类别字号"
Height = 225
Index = 0
Left = 750
TabIndex = 47
Top = 1380
Width = 825
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "附单据数"
Height = 255
Index = 2
Left = 7860
TabIndex = 46
Top = 1380
Width = 825
End
Begin VB.Label Lab_Book
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 195
Left = 3240
TabIndex = 45
Top = 6390
Width = 45
End
Begin VB.Label Lab_Checker
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 195
Left = 7380
TabIndex = 44
Top = 6390
Width = 45
End
Begin VB.Label Lab_Bill
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 195
Left = 9180
TabIndex = 43
Top = 6390
Width = 45
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "会计期间"
Height = 255
Index = 9
Left = 7860
TabIndex = 42
Top = 1050
Width = 825
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "字"
Height = 195
Index = 10
Left = 2040
TabIndex = 41
Top = 1380
Visible = 0 'False
Width = 255
End
Begin VB.Label Lab_OperStatus
BackColor = &H000080FF&
Caption = "2"
Height = 225
Left = 6930
TabIndex = 40
Top = 840
Visible = 0 'False
Width = 195
End
Begin VB.Label Lab_Row
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00FF0000&
Height = 225
Left = 9000
TabIndex = 39
Top = 690
Width = 315
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "(第"
Height = 255
Index = 11
Left = 8700
TabIndex = 38
Top = 690
Width = 315
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "行)"
Height = 255
Index = 12
Left = 9330
TabIndex = 37
Top = 690
Width = 405
End
Begin VB.Label Lab_Pzclzt
BackColor = &H0000FFFF&
Caption = "1"
ForeColor = &H00808080&
Height = 255
Left = 6600
TabIndex = 36
Top = 840
Visible = 0 'False
Width = 285
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "当前记录"
Height = 255
Index = 13
Left = 7860
TabIndex = 35
Top = 690
Width = 825
End
Begin VB.Label Lab_Succeed
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "已生成"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 405
Left = 90
TabIndex = 34
Top = 600
Visible = 0 'False
Width = 1005
End
Begin VB.Label Lab_Error
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "有错"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 390
Left = 1200
TabIndex = 33
Top = 600
Visible = 0 'False
Width = 825
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 195
Left = 10140
TabIndex = 32
Top = 6330
Width = 45
End
Begin VB.Label Label2
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 195
Left = 5100
TabIndex = 31
Top = 6390
Width = 45
End
Begin VB.Label Label5
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 225
Left = 2790
TabIndex = 30
Top = 30
Width = 735
End
Begin VB.Label TsLabel
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "出纳:"
Height = 195
Index = 19
Left = 4620
TabIndex = 29
Top = 6390
Width = 405
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "会计主管:"
Height = 225
Index = 20
Left = 360
TabIndex = 28
Top = 6390
Width = 855
End
Begin VB.Label TsLabel
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "记帐人:"
Height = 195
Index = 21
Left = 2595
TabIndex = 27
Top = 6390
Width = 585
End
Begin VB.Label TsLabel
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "审核人:"
Height = 195
Index = 22
Left = 6645
TabIndex = 26
Top = 6390
Width = 585
End
Begin VB.Label TsLabel
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "制单人:"
Height = 195
Index = 23
Left = 8520
TabIndex = 25
Top = 6390
Width = 585
End
Begin VB.Label Lab_VouchId
AutoSize = -1 'True
BackColor = &H0080C0FF&
Height = 300
Left = 2250
TabIndex = 24
Top = 630
Visible = 0 'False
Width = 1170
End
Begin VB.Label lbl_Tag
BackColor = &H00FF8080&
Height = 285
Left = 3510
TabIndex = 23
Top = 690
Visible = 0 'False
Width = 555
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "出纳:"
Height = 225
Index = 14
Left = 4680
TabIndex = 4
Top = 6900
Width = 645
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "会计主管:"
Height = 225
Index = 3
Left = 420
TabIndex = 3
Top = 6900
Width = 855
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "记帐:"
Height = 225
Index = 8
Left = 2655
TabIndex = 2
Top = 6900
Width = 645
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "审核:"
Height = 225
Index = 7
Left = 6705
TabIndex = 1
Top = 6900
Width = 495
End
Begin VB.Label TsLabel
BackStyle = 0 'Transparent
Caption = "制单:"
Height = 225
Index = 5
Left = 8580
TabIndex = 0
Top = 6900
Width = 525
End
End
Attribute VB_Name = "CL_PzFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************
'* 模块名称 :自动转帐凭证处理
'* 功能描述 :此功能模块主要完成凭证录入、修改、删除、预览打印等。
'* 程序员姓名 : 杨波
'* 最后修改人 : 杨波
'* 最后修改时间:2001/10/19
'* 备注:程序中所有依实际情况自定义部分均用[>> <<]括起
'*
'* 1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
'*
'* 2.网格列存储内容注解
'* 0-行有效标识 1-结算方式编码 2-结算方式名称 3-票号 4-发生日期 5-数量 6-用户录入单价(显示时自动计算)
'* 7-计量单位 8-外币编码 9-外币名称 10-外币金额 11-汇率 12-部门编码 13-部门名称
'* 14-客户编码 15-客户名称 16-职员编码 17-职员名称 18-项目大类编码 19-项目大类名称
'* 20-项目编码 21-项目名称 22-项目数量 23-项目计量单位 24-经办人 25-供应商编码 26-供应商名称
'*
'* 索引对照:001-摘要 002-科目编码 003-科目名称 004-借方金额 005-贷方金额
'*
'* 3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) "1"-浏览 "2"-新增 "3"-修改
'*
'* 4.Lab_Pzclzt 用此标签来标识凭证处理状态(默认值为1) "1"-填制凭证 "2"-查询凭证列表 "3"-审核凭证
'* "4"-明细帐联查凭证
'*
'* 5.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
'* 6.当执行“下张、上张、首张、末张”，写临时凭证；当“保存”时，则保存到正式凭证中，同时写临时凭证。
'*
'*********************************************************************************************************
'[以下为根据实际情况设置变量
Dim Int_AssCount As Integer '辅助核算项目总数
Dim Bln_AssShow() As Boolean '辅助核算项目是否显示
Dim Bln_AssHelp() As Boolean '辅助核算项目是否有帮助
Dim Str_Digest As String '最后录入的一条凭证分录的摘要内容
Dim Bln_BillChange As Boolean '标识单据是否发生改动
Dim Int_Year As Integer '年份
Dim Int_Period As Integer '会计期间
Dim Rec_VouchMainTemp As New ADODB.Recordset '临时凭证主表
Dim Rec_VouchTemp As New ADODB.Recordset '临时凭证辅表
Dim Rectemp As New ADODB.Recordset '临时数据表
Dim SqlStr As String '临时查询字符串
Dim Rec_TranMainTemp As New ADODB.Recordset '本批结转的所有凭证记录集
Dim Max_VouchIdTemp As Integer '本批凭证中最大的VouchIdTemp值
Dim Min_VouchIdTemp As Integer '本批凭证中最小的VouchIdTemp值
']
'以下为固定使用变量(网格)
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)
'以下为固定使用变量 (文本框)
Dim Textvar() As Variant '存储变体型文本框信息
Dim Textboolean() As Boolean '存储布尔型文本框信息
Dim Textint() As Integer '存储整型文本框信息
Dim Textstr() As String '存储字符型文本框信息
Dim Max_Text_Index As Integer '最大录入文本框索引值
Dim TextGroupCode As String '文本框录入分组编码
Dim TextValiLock As Boolean '文本框失去焦点是否进行有效性控制判断
Dim TextValiJudgeLock() As Boolean '文本框录入有效性判断控制锁
Dim TextChangeLock As Boolean '文本框内容变换控制锁
Dim Bln_Cancel As Boolean '取消按钮信息传递
Dim currrecord As Integer
Dim MLoadMassage As Integer
Private Sub Form_KeyPress(KeyAscii As Integer) '控制焦点转移
Dim jdzygs As Integer
jdzygs = 3
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() '窗体装入
'初始化各种锁值
Changelock = False '网格行列改变控制锁
Gdtlock = False '滚动条滚动控制
Yxxpdlock = True '字段有效性判断锁
Hyxxpdlock = True '行有效性判断锁
Wbkbhlock = False '文本框内容改变锁
'[>>开始设置辅助核算项目属性
Int_AssCount = 14
ReDim Bln_AssShow(Int_AssCount - 1)
ReDim Bln_AssHelp(Int_AssCount - 1)
Bln_AssHelp(0) = True '结算方式
Bln_AssHelp(2) = True '发生日期
Bln_AssHelp(7) = True '部门
Bln_AssHelp(8) = True '往来客户
Bln_AssHelp(9) = True '个人
Bln_AssHelp(10) = True '项目
Bln_AssHelp(12) = True '供应商
Bln_AssHelp(13) = True '经办人
'完毕<<]
'报表主标题及报表编码
ReportTitle = "记帐凭证"
XtReportCode = "chhs_jzpzcl"
Load Dyymctbl
'以下为文本框处理程序
TextGroupCode = "chhs_jzpzcl"
Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
Call Wbkcsh
'调入网格
GridCode = "chhs_jzpzcl" '网格属性编码
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
GridBoolean(Sydz("002", GridStr(), Szzls), 1) = False
GridBoolean(Sydz("004", GridStr(), Szzls), 1) = False
GridBoolean(Sydz("005", GridStr(), Szzls), 1) = False
For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
WglrGrid.RowHeight(Jsqte) = Sjhgd
Next Jsqte
'[>>置删行是否提示状态
If Shsfts Then
Chk_DeleteMess.Value = 1
Else
Chk_DeleteMess.Value = 0
End If
'<<]
'设置首张、上张、下张、末张的状态
If CL_MakeVoucherSub.vsFlex_PzMain.Rows - CL_MakeVoucherSub.vsFlex_PzMain.FixedRows > 1 Then
Tlb_Action.Buttons("first").Enabled = True '首张
Tlb_Action.Buttons("prev").Enabled = True '上张
Tlb_Action.Buttons("next").Enabled = True '下张
Tlb_Action.Buttons("last").Enabled = True '末张
Else
Tlb_Action.Buttons("first").Enabled = False '首张
Tlb_Action.Buttons("prev").Enabled = False '上张
Tlb_Action.Buttons("next").Enabled = False '下张
Tlb_Action.Buttons("last").Enabled = False '末张
End If
currrecord = 1
'当前会计区间
Combo_Kjqj.Text = Trim(Str(PGKjYear)) + "." + Trim(Str(PGNowmon))
'初始化合计网格
Call Cshhjwg
'单据变动置为False
Bln_BillChange = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim count As Integer
' 判断是否有没有存盘的转帐凭证
If lbl_Tag.Caption = "0" Then
For count = CL_MakeVoucherSub.vsFlex_PzMain.FixedRows To CL_MakeVoucherSub.vsFlex_PzMain.Rows - CL_MakeVoucherSub.vsFlex_PzMain.FixedRows
If CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(count, 3) <> "1" Then
CL_NoSaveList.Show 1
Tsxx = "凭证没有全部保存，退出吗？"
If Xtxxts(Tsxx, 1, 2) = 6 Then '若退出
GoTo a1
Else
Cancel = 1
Exit Sub
End If
End If
Next count
End If
If lbl_Tag.Caption = "1" Then
If CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(CL_MakeVoucherSub.vsFlex_PzMain.FixedRows, 3) <> "1" Then
CL_NoSaveList.Show 1
Tsxx = "凭证没有全部保存，退出吗？"
If Xtxxts(Tsxx, 1, 2) = 6 Then '若退出
GoTo a1
Else
Cancel = 1
Exit Sub
End If
End If
End If
a1:
'卸载打印页面窗体
Unload Dyymctbl
'卸载生成凭证子窗体
If MLoadMassage = 0 Then
Unload CL_MakeVoucherSub
CL_MakeVoucher.Timer1.Enabled = True
End If
'判断凭证是否发生变化
If Bln_BillChange Then
Xtfhcs = "1"
Else
Xtfhcs = "0"
End If
Set Rec_VouchMainTemp = Nothing
Set Rec_VouchTemp = Nothing
Set Rectemp = Nothing
Set Rec_TranMainTemp = Nothing
Set Rs_TranMainTemp = Nothing
Unload Me
End Sub
Private Sub Timer1_Timer() '根据不同凭证或单据状态处理不同的数据初始化
'关闭定时器
Timer1.Enabled = False
Call Sjcsh(Trim(Lab_Pzclzt.Caption))
'填充会计期间列表框(年度默认为用户选择年度)
Int_Year = Val(Mid(Combo_Kjqj.Text, 1, 4))
Int_Period = Val(Mid(Combo_Kjqj.Text, 6, 2))
End Sub
Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
Dim SqlStr As String '查询凭证列表条件
'[>>根据实际情况初始化
Select Case Str_Pzclzt
Case "1" '编辑凭证
'日期默认值为用户选择日期
LrText(1).Text = Format(Xtrq, "yyyy-mm-dd")
'设置操作状态为浏览
Select Case lbl_Tag.Caption
Case "0"
Lab_OperStatus = "2" '新增状态
Call Sub_OperStatus("30")
Call Sub_ShowBill(1)
Case "1"
Lab_OperStatus = "2" '新增状态
Call Sub_OperStatus("30")
Call sub_HBShow
Case "2"
Lab_OperStatus = "1" '浏览状态
Call Sub_OperStatus("11")
Call Sub_ShowPz
Case "3"
Lab_OperStatus = "2" '浏览状态
Call Sub_OperStatus("30")
Call Sub_ShowPz
End Select
End Select
'<<]
'重置网格
Call Sub_AdjustGrid
End Sub
Private Sub Sub_ShowBill(arry As Integer) '根据当前单据号显示整张单据内容
Dim count As Long '临时计数器
'[>>显示单据头
TextChangeLock = True
LrText(0) = vouchz '凭证类别
LrText(1) = Format(Trim(CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(arry, 1)), "yyyy-mm-dd") '制单日期
LrText(2) = Trim(CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(arry, 2)) '随单据
Lab_Bill = Xtczy '制单人
TextChangeLock = False
WglrGrid.Rows = WglrGrid.FixedRows
'[>>显示单据分录
With CL_MakeVoucherSub.vsFlex_PzChild
For count = .FixedRows To .Rows - 1
If Trim(.TextMatrix(count, 0)) = Trim(CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(arry, 0)) And Val(.TextMatrix(count, 28)) = Val(CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(arry, 5)) Then
If Val(.TextMatrix(count, 4)) = Val(.TextMatrix(count, 5)) Then
Else
WglrGrid.AddItem ""
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 0) = "*" '行标识
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 1) = Trim(.TextMatrix(count, 7)) '结算方式
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 2) = Trim(.TextMatrix(count, 8))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 3) = Trim(.TextMatrix(count, 9)) '票号
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 4) = Trim(.TextMatrix(count, 10)) '发生日期
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 5) = Trim(.TextMatrix(count, 11)) '数量
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 6) = Trim(.TextMatrix(count, 12)) '单价
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 10) = Trim(.TextMatrix(count, 13)) '外币金额
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 11) = Trim(.TextMatrix(count, 14)) '汇率
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 12) = Trim(.TextMatrix(count, 15)) '部门
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 13) = Trim(.TextMatrix(count, 16))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 14) = Trim(.TextMatrix(count, 17)) '客户
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 15) = Trim(.TextMatrix(count, 18))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 16) = Trim(.TextMatrix(count, 19)) '个人
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 17) = Trim(.TextMatrix(count, 20))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 20) = Trim(.TextMatrix(count, 21)) '项目
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 21) = Trim(.TextMatrix(count, 22))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 22) = Trim(.TextMatrix(count, 23)) '项目数量
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 23) = Trim(.TextMatrix(count, 24))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 25) = Trim(.TextMatrix(count, 25)) '供应商
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 26) = Trim(.TextMatrix(count, 26))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 24) = Trim(.TextMatrix(count, 27)) '经办人
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 27) = Trim(.TextMatrix(count, 6)) '科目标志
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("001", GridStr(), Szzls)) = Trim(.TextMatrix(count, 1)) '摘要
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("002", GridStr(), Szzls)) = Trim(.TextMatrix(count, 2)) '科目编码
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("003", GridStr(), Szzls)) = Trim(.TextMatrix(count, 3)) '科目名称
If Val(.TextMatrix(count, 4)) > Val(.TextMatrix(count, 5)) Then
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("004", GridStr(), Szzls)) = Val(.TextMatrix(count, 4)) - Val(.TextMatrix(count, 5)) '借方金额
Else
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("005", GridStr(), Szzls)) = Val(.TextMatrix(count, 5)) - Val(.TextMatrix(count, 4)) '贷方金额
End If
End If
End If
Next count
End With
'计算凭证号
Call Sub_JsVouchNo
'调整网格
Call Sub_AdjustGrid
'显示备注信息
Call Sub_ShowMemo(WglrGrid.Row)
'计算合计数据
For count = Qslz To WglrGrid.Cols - 1
Call Sjhj(count)
Next count
'
If CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(currrecord, 3) = "1" Then
Lab_Succeed.Visible = True
Lab_OperStatus = "1"
Call Sub_OperStatus("11")
Else
Lab_Succeed.Visible = False
Lab_OperStatus = "2"
Call Sub_OperStatus("30")
End If
End Sub
Private Sub sub_HBShow()
Dim count As Long '临时计数器
'[>>显示单据头
TextChangeLock = True
LrText(0) = vouchz '凭证类别
LrText(1) = Format(Xtrq, "yyyy-mm-dd") '制单日期
LrText(2) = Trim(CL_MakeVoucherSub.vsFlex_PzMain.Rows - 1) '随单据
Lab_Bill = Xtczy '制单人
TextChangeLock = False
WglrGrid.Rows = WglrGrid.FixedRows
'[>>显示单据分录
With CL_MakeVoucherSub.vsFlex_PzChild
For count = .FixedRows To .Rows - 1
If Val(.TextMatrix(count, 4)) = Val(.TextMatrix(count, 5)) Then
Else
WglrGrid.AddItem ""
WglrGrid.RowHeight(count) = Sjhgd
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 0) = "*" '行标识
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 1) = Trim(.TextMatrix(count, 7)) '结算方式
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 2) = Trim(.TextMatrix(count, 8))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 3) = Trim(.TextMatrix(count, 9)) '票号
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 4) = Trim(.TextMatrix(count, 10)) '发生日期
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 5) = Trim(.TextMatrix(count, 11)) '数量
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 6) = Trim(.TextMatrix(count, 12)) '单价
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 10) = Trim(.TextMatrix(count, 13)) '外币金额
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 11) = Trim(.TextMatrix(count, 14)) '汇率
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 12) = Trim(.TextMatrix(count, 15)) '部门
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 13) = Trim(.TextMatrix(count, 16))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 14) = Trim(.TextMatrix(count, 17)) '客户
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 15) = Trim(.TextMatrix(count, 18))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 16) = Trim(.TextMatrix(count, 19)) '个人
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 17) = Trim(.TextMatrix(count, 20))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 20) = Trim(.TextMatrix(count, 21)) '项目
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 21) = Trim(.TextMatrix(count, 22))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 22) = Trim(.TextMatrix(count, 23)) '项目数量
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 23) = Trim(.TextMatrix(count, 24))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 25) = Trim(.TextMatrix(count, 25)) '供应商
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 26) = Trim(.TextMatrix(count, 26))
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 24) = Trim(.TextMatrix(count, 27)) '经办人
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, 27) = Trim(.TextMatrix(count, 6)) '科目标志
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("001", GridStr(), Szzls)) = Trim(.TextMatrix(count, 1)) '摘要
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("002", GridStr(), Szzls)) = Trim(.TextMatrix(count, 2)) '科目编码
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("003", GridStr(), Szzls)) = Trim(.TextMatrix(count, 3)) '科目名称
If Val(.TextMatrix(count, 4)) > Val(.TextMatrix(count, 5)) Then
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("004", GridStr(), Szzls)) = Val(.TextMatrix(count, 4)) - Val(.TextMatrix(count, 5)) '借方金额
Else
WglrGrid.TextMatrix(WglrGrid.Rows - WglrGrid.FixedRows, Sydz("005", GridStr(), Szzls)) = Val(.TextMatrix(count, 5)) - Val(.TextMatrix(count, 4)) '贷方金额
End If
End If
Next count
End With
'计算凭证号
Call Sub_JsVouchNo
'调整网格
Call Sub_AdjustGrid
'显示备注信息
Call Sub_ShowMemo(WglrGrid.Row)
'计算合计数据
For count = Qslz To WglrGrid.Cols - 1
Call Sjhj(count)
Next count
'
If CL_MakeVoucherSub.vsFlex_PzMain.TextMatrix(currrecord, 3) = "1" Then
Lab_Succeed.Visible = True
Lab_OperStatus = "1"
Call Sub_OperStatus("11")
Else
Lab_Succeed.Visible = False
Lab_OperStatus = "2"
Call Sub_OperStatus("30")
End If
End Sub
Private Sub Sub_ShowPz()
Dim Jsqte As Long '临时计数器
Dim SqlStr As String
Dim Rectemp As ADODB.Recordset
SqlStr = "select * from chhs_v_vouch where VouchId='" & Val(Trim(Lab_VouchId.Caption)) & "' Order by SerialID"
Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With Rectemp
WglrGrid.Clear 1
If .EOF Then
Exit Sub
Else
WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
'[>>显示单据头
TextChangeLock = True
LrText(0).Text = Trim(.Fields("VouchClassCode")) '凭证类别
If Lab_Succeed.Caption = "已生成" Then
LrText(3).Text = Mid(Trim(Str(10000 + .Fields("VouchNo"))), 2, 4) '凭证号
End If
If IsDate(.Fields("DDate")) Then
LrText(1).Text = Format(.Fields("Ddate"), "yyyy-mm-dd") '制单日期
End If
LrText(2).Text = Trim(Str(.Fields("Doc"))) '附单据数
Lab_Bill.Caption = Trim(.Fields("Bill") & "") '制单人
Lab_Checker.Caption = "" '审核人
Lab_Book.Caption = "" '记帐人
Lab_Error.Visible = False '标错
TextChangeLock = False
'<<]
End If
Jsqte = WglrGrid.FixedRows
Do While Not .EOF
If Jsqte >= WglrGrid.Rows Then
WglrGrid.AddItem ""
End If
'[>>显示单据分录
WglrGrid.TextMatrix(Jsqte, 0) = "*" '行标识
WglrGrid.TextMatrix(Jsqte, 1) = "" '结算方式编码
WglrGrid.TextMatrix(Jsqte, 2) = "" '结算方式名称
WglrGrid.TextMatrix(Jsqte, 3) = "" '票号
If IsDate(.Fields("BillDate") & "") Then
WglrGrid.TextMatrix(Jsqte, 4) = Format(.Fields("BillDate"), "yyyy-mm-dd") '发生日期
End If
If .Fields("Jfsl") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 5) = Trim(Str(.Fields("Jfsl"))) '数量
End If
If .Fields("Dfsl") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 5) = Trim(Str(.Fields("Dfsl"))) '数量
End If
WglrGrid.TextMatrix(Jsqte, 7) = "" '计量单位
'币种为外币时填充网格
If Trim(.Fields("ForeignCurrCode") & "") <> XtSCurrCode Then
WglrGrid.TextMatrix(Jsqte, 8) = Trim(.Fields("ForeignCurrCode") & "") '原币编码
WglrGrid.TextMatrix(Jsqte, 9) = Trim(.Fields("ForeignCurrName") & "") '原币名称
If .Fields("Wbjfje") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 10) = Trim(Str(.Fields("Wbjfje"))) '原币金额
End If
If .Fields("Wbdfje") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 10) = Trim(Str(.Fields("Wbdfje"))) '原币金额
End If
If .Fields("AccRate") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 11) = Trim(Str(.Fields("AccRate"))) '记帐汇率
End If
End If
WglrGrid.TextMatrix(Jsqte, 12) = Trim(.Fields("DeptCode") & "") '部门编码
WglrGrid.TextMatrix(Jsqte, 13) = Trim(.Fields("DeptName") & "") '部门名称
WglrGrid.TextMatrix(Jsqte, 14) = Trim(.Fields("CusCode") & "") '客户编码
WglrGrid.TextMatrix(Jsqte, 15) = Trim(.Fields("CusName") & "") '客户名称
WglrGrid.TextMatrix(Jsqte, 25) = Trim(.Fields("SupplierCode") & "") '供应商编码
WglrGrid.TextMatrix(Jsqte, 26) = Trim(.Fields("SupplierName") & "") '供应商名称
WglrGrid.TextMatrix(Jsqte, 16) = Trim(.Fields("PersonCode") & "") '职员编码
WglrGrid.TextMatrix(Jsqte, 17) = Trim(.Fields("PersonName") & "") '职员名称
WglrGrid.TextMatrix(Jsqte, 18) = Trim(.Fields("ItemClassCode") & "") '项目类别编码
WglrGrid.TextMatrix(Jsqte, 19) = Trim(.Fields("ItemClassName") & "") '项目类别名称
WglrGrid.TextMatrix(Jsqte, 20) = Trim(.Fields("ItemCode") & "") '项目编码
WglrGrid.TextMatrix(Jsqte, 21) = Trim(.Fields("ItemName") & "") '项目名称
If Val(Trim(.Fields("ItemJfsl") & "")) <> 0 Then
WglrGrid.TextMatrix(Jsqte, 22) = Trim(Str(.Fields("ItemJfsl"))) '项目数量
End If
If Val(Trim(.Fields("ItemDfsl") & "")) <> 0 Then
WglrGrid.TextMatrix(Jsqte, 22) = Trim(Str(.Fields("ItemDfsl"))) '项目数量
End If
WglrGrid.TextMatrix(Jsqte, 24) = Trim(.Fields("TranPerson") & "") '经办人
WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Digest")) '摘要
WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Ccode")) '科目编码
WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Cname") & "") '科目名称
If .Fields("Jfje") <> 0 Then
WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(Str(.Fields("Jfje"))) '借方金额
Else
WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(Str(.Fields("Dfje"))) '贷方金额
End If
'<<]
WglrGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Jsqte = Jsqte + 1
Loop
End With
'调整网格
Call Sub_AdjustGrid
'显示备注信息
Call Sub_ShowMemo(WglrGrid.Row)
'计算合计数据
For Jsqte = Qslz To WglrGrid.Cols - 1
Call Sjhj(Jsqte)
Next Jsqte
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 "bc" '保存
Call Sub_SaveBill
Case "fq" '放弃
Call Sub_AbandonBill
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
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '支持热键操作
Select Case KeyCode
Case vbKeyF6 '保存凭证
If Tlb_Action.Buttons("bc").Enabled Then
Call Sub_SaveBill
End If
End Select
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 Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
With Tlb_Action
Select Case Str_Status
Case "11" '浏览(放弃修改单据,查询单据,明细帐联查凭证)
'工具条
.Buttons("dy").Enabled = True '打印
.Buttons("yl").Enabled = True '预览
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
'录入文本框
For Jsqte = Max_Text_Index To 0 Step -1
LrText(Jsqte).Enabled = False
Next Jsqte
Ydtext.Visible = False
Ydcommand.Visible = False
'合计金额大写显示
HjGrid.TextMatrix(0, Sydz("003", GridStr(), Szzls)) = Fun_Jezh(Val(HjGrid.TextMatrix(0, Sydz("004", GridStr(), Szzls))))
Case "30" '修改(生成)
'工具条
If Lab_Succeed.Caption = "已生成" Then
.Buttons("dy").Enabled = True '打印
.Buttons("yl").Enabled = True '预览
Else
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
End If
.Buttons("zh").Enabled = True '增行
.Buttons("sh").Enabled = True '删行
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
Select Case lbl_Tag.Caption
Case "1", "2", "3"
.Buttons("first").Enabled = False
.Buttons("prev").Enabled = False
.Buttons("next").Enabled = False
.Buttons("last").Enabled = False
End Select
'录入文本框
For Jsqte = 0 To Max_Text_Index
LrText(Jsqte).Enabled = True
Next Jsqte
LrText(0).Enabled = False
LrText(3).Enabled = False
Ydtext.Visible = False
Ydcommand.Visible = False
'清空合计大写
HjGrid.TextMatrix(0, Sydz("003", GridStr(), Szzls)) = ""
Case "30" '修改(合并)
End Select
End With
End Sub
Private Sub Wbkcl() '文本框录入之前处理(根据实际情况)
Dim xswbrr As String
With WglrGrid
Zdlrqnr = Trim(.Text)
xswbrr = Trim(.Text)
If GridBoolean(.Col, 3) Then '列表框录入
Else
Wbkbhlock = True
'====以下为用户自定义
Ydtext.Text = xswbrr
'====以上为用户自定义
Wbkbhlock = False
Ydtext.SelStart = Len(Ydtext.Text)
End If
End With
End Sub
Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) '录入数据字段有效性判断,同时进行字段录入事后处理
Dim Str_JudgeText As String '临时有效性判断字段内容
Dim Coljsq As Long '临时列计数器
Dim Rectemp As New ADODB.Recordset '临时使用动态集
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 Len(Str_JudgeText) <> 0 Then
SqlStr = "SELECT * FROM Cwzz_Digest Where DigestCode='" & Str_JudgeText & "'"
Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not Rectemp.EOF Then
.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(Rectemp.Fields("DigestText"))
End If
'保存最后录入的一条凭证分录的摘要内容
Str_Digest = .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))
End If
'2.放置字段事后处理程序
'以上为自定义部分]
End Select
'字段录入正确后为零字段清空
Call Qkwlzd(Dqpdwgh, Dqpdwgl)
'字段录入正确后进行数据合计
For Coljsq = Qslz To .Cols - 1
Call Sjhj(Coljsq)
Next Coljsq
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 Bln_AssVali As Boolean '辅助核算错误
Dim Jsqte As Long '临时计数器
With WglrGrid
If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
'判断行为空和无效数据行则清除当前行
If .TextMatrix(Yxxpdh, 0) <> "*" Then
Sjhzyxxpd = True
Exit Function
Else
If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
Changelock = True
.RemoveItem Yxxpdh
If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
End If
Changelock = False
Sjhzyxxpd = True
Exit Function
End If
End If
End If
'行没有发生变化则不进行有效性判断
If Hyxxpdlock Then
Sjhzyxxpd = True
Exit Function
End If
'以下为自定义部分[
'1.放置行有效性判断程序
'首先进行为空判断(固定不变)
For Jsqte = Qslz To .Cols - 1
If (GridInt(Jsqte, 5) = 1 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
'2.[自定义判断(补丁)
If Val(Trim(.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))) = 0 And Val(Trim(.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))) = 0 Then
Tsxx = "借方和贷方金额不能同时为零!"
Lrywlz = Sydz("004", GridStr(), Szzls)
GoTo Lrcwcl
End If
If Val(Trim(.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))) <> 0 And Val(Trim(.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))) <> 0 Then
Tsxx = "借方和贷方金额不能同时不为零!"
Lrywlz = Sydz("004", GridStr(), Szzls)
GoTo Lrcwcl
End If
'判断辅助核算项目是否填写
SqlStr = "Select * FROM Cwzz_AccCode Where Ccode='" & Trim(.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls))) & "'"
Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With Rectemp
If Not .EOF Then
'如有数量核算且用户选择数量不能为零则数量项不能为零
If Rectemp.Fields("QuantityFlag") And Chk_Quantity.Value = 1 And Val(WglrGrid.TextMatrix(Yxxpdh, 5)) = 0 Then
Tsxx = "此科目需要数量核算,数量项不能为零!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
'部门核算则部门不能为空
If Rectemp.Fields("DeptFlag") And Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 12))) = 0 Then
Tsxx = "此科目需要部门核算,部门项不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
'往来客户核算则往来单位不能为空
If Rectemp.Fields("CusFlag") And Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 14))) = 0 Then
Tsxx = "此科目需要往来客户核算,往来客户项不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
'往来供应商核算则往来供应商不能为空
If Rectemp.Fields("SupplierFlag") And Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 25))) = 0 Then
Tsxx = "此科目需要往来供应商核算,往来供应商项不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
'个人往来核算则个人项不能为空
If Rectemp.Fields("PersonFlag") And Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 16))) = 0 Then
Tsxx = "此科目需要个人往来核算,个人项不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
'项目核算则项目不能为空
If Rectemp.Fields("ItemFlag") And Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 20))) = 0 Then
Tsxx = "此科目需要项目核算,核算项目不能为空!"
Lrywlz = Sydz("002", GridStr(), Szzls)
Bln_AssVali = True
GoTo Lrcwcl
End If
End If
End With
'2.放置行处理程序
'以上为自定义部分]
End With
Sjhzyxxpd = True
Hyxxpdlock = True
Exit Function
Lrcwcl: '录入错误处理
With WglrGrid
Call Xtxxts(Tsxx, 0, 1)
Changelock = True
.Select Yxxpdh, Lrywlz
Changelock = False
'[>>如果辅助核算出现错误则调用辅助核算功能
If Bln_AssVali Then
Call Sub_Drfzhsx(Yxxpdh, Trim(.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls))))
'解决鼠标点击取消造成的换行
Changelock = True
.Select Yxxpdh, Lrywlz
Changelock = False
'<<]
Else
Call xswbk
End If
Sjhzyxxpd = False
Exit Function
End With
End Function
Private Sub Lab_Memo_DblClick(Index As Integer) '点击辅助核算信息列
'如果单据操作状态为浏览状态则不能显示录入载体
If Trim(Lab_OperStatus.Caption) = "1" Then
Exit Sub
End If
'当科目编码处于录入状态时不能调入辅助核算项目
If Ydtext.Visible And GridStr(WglrGrid.Col, 1) = "002" Then
Exit Sub
End If
'当焦点处于非录入区域时也不能调入辅助核算项目
If WglrGrid.Row < WglrGrid.FixedRows Then
Exit Sub
End If
'屏蔽文本框,下拉组合框有效性判断
Valilock = True
Call Sub_Drfzhsx(WglrGrid.Row, Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("002", GridStr(), Szzls))))
Valilock = False
End Sub
Private Sub Sub_Drfzhsx(Dqpdwgh As Long, Str_JudgeText As String) '判断科目是否有辅助核算,如有则调入辅助核算窗体
' 函数参数：当前判断网格行，判断科目
Dim Coljsq As Long '临时列计数器
Dim Rectemp As New ADODB.Recordset '临时使用动态集
If Len(Str_JudgeText) <> 0 Then
SqlStr = "Select Cwzz_AccCode.* ,ItemClassName,ForeignCurrName,ConVertFlag FROM Cwzz_AccCode " & _
" LEFT OUTER JOIN Cwzz_ItemClass ON Cwzz_AccCode.ItemClassCode = Cwzz_ItemClass.ItemClassCode " & _
" LEFT OUTER JOIN Gy_ForeignCurrency ON Cwzz_AccCode.ForeignCurrCode= Gy_ForeignCurrency.ForeignCurrCode " & _
" Where Ccode='" + Str_JudgeText + "' and EndFlag=1 and StopFlag=0"
Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With Rectemp
If .EOF Then
Exit Sub
Else
'判断科目进行哪些辅助核算
'清空辅助核算标识
For Jsqte = 0 To Int_AssCount - 1
Bln_AssShow(Jsqte) = False
Next Jsqte
' 客户往来，供应商往来，银行科目需录入经办人
If Trim(Rectemp.Fields("Cproperty")) = "银行" Or Rectemp.Fields("CusFlag") Or Rectemp.Fields("SupplierFlag") Then
Bln_AssShow(13) = True '经办人
Else
WglrGrid.TextMatrix(Dqpdwgh, 24) = ""
End If
' 银行科目 --结算方式?票号?日期
If Trim(Rectemp.Fields("Cproperty")) = "银行" Then
Bln_AssShow(0) = True '结算方式
Bln_AssShow(1) = True '票号
Bln_AssShow(2) = True '日期
Bln_AssShow(13) = True '经办人
Else
WglrGrid.TextMatrix(Dqpdwgh, 1) = ""
WglrGrid.TextMatrix(Dqpdwgh, 2) = ""
WglrGrid.TextMatrix(Dqpdwgh, 3) = ""
WglrGrid.TextMatrix(Dqpdwgh, 4) = ""
End If
'数量核算 --数量, 单价
If Rectemp.Fields("QuantityFlag") Then
Bln_AssShow(3) = True '数量
Bln_AssShow(4) = True '单价
WglrGrid.TextMatrix(Dqpdwgh, 6) = ""
WglrGrid.TextMatrix(Dqpdwgh, 7) = Trim(.Fields("measure")) '单位
Else
WglrGrid.TextMatrix(Dqpdwgh, 5) = ""
WglrGrid.TextMatrix(Dqpdwgh, 6) = ""
WglrGrid.TextMatrix(Dqpdwgh, 7) = ""
End If
'外币核算 --外币, 汇率
If Rectemp.Fields("ForeignFlag") Then
WglrGrid.TextMatrix(Dqpdwgh, 8) = Trim(.Fields("ForeignCurrCode"))
WglrGrid.TextMatrix(Dqpdwgh, 9) = Trim(.Fields("ForeignCurrName"))
Bln_AssShow(5) = True '外币金额
Bln_AssShow(6) = True '汇率
Else
WglrGrid.TextMatrix(Dqpdwgh, 8) = ""
WglrGrid.TextMatrix(Dqpdwgh, 9) = ""
WglrGrid.TextMatrix(Dqpdwgh, 10) = ""
WglrGrid.TextMatrix(Dqpdwgh, 11) = ""
End If
'部门核算
If Rectemp.Fields("DeptFlag") Then
Bln_AssShow(7) = True '部门
Else
WglrGrid.TextMatrix(Dqpdwgh, 12) = ""
WglrGrid.TextMatrix(Dqpdwgh, 13) = ""
End If
'客户核算
If Rectemp.Fields("CusFlag") Then
Bln_AssShow(8) = True '客户
Else
WglrGrid.TextMatrix(Dqpdwgh, 14) = ""
WglrGrid.TextMatrix(Dqpdwgh, 15) = ""
End If
'供应商核算
If Rectemp.Fields("SupplierFlag") Then
Bln_AssShow(12) = True '供应商
Else
WglrGrid.TextMatrix(Dqpdwgh, 25) = ""
WglrGrid.TextMatrix(Dqpdwgh, 26) = ""
End If
'个人核算
If Rectemp.Fields("PersonFlag") Then
Bln_AssShow(9) = True '个人
Else
WglrGrid.TextMatrix(Dqpdwgh, 16) = ""
WglrGrid.TextMatrix(Dqpdwgh, 17) = ""
End If
'项目核算
If Rectemp.Fields("ItemFlag") Then
If WglrGrid.TextMatrix(Dqpdwgh, 18) <> Trim(.Fields("ItemClassCode")) Then
WglrGrid.TextMatrix(Dqpdwgh, 20) = ""
WglrGrid.TextMatrix(Dqpdwgh, 21) = ""
WglrGrid.TextMatrix(Dqpdwgh, 22) = ""
WglrGrid.TextMatrix(Dqpdwgh, 23) = ""
End If
WglrGrid.TextMatrix(Dqpdwgh, 18) = Trim(.Fields("ItemClassCode")) '项目类别编码
WglrGrid.TextMatrix(Dqpdwgh, 19) = Trim(.Fields("ItemClassName")) '项目类别名称
Bln_AssShow(10) = True '项目
Bln_AssShow(11) = True '项目数量
Else
WglrGrid.TextMatrix(Dqpdwgh, 18) = ""
WglrGrid.TextMatrix(Dqpdwgh, 19) = ""
WglrGrid.TextMatrix(Dqpdwgh, 20) = ""
WglrGrid.TextMatrix(Dqpdwgh, 21) = ""
WglrGrid.TextMatrix(Dqpdwgh, 22) = ""
WglrGrid.TextMatrix(Dqpdwgh, 23) = ""
End If
'调入科目辅助核算项目
For Jsqte = 0 To Int_AssCount - 1
If Bln_AssShow(Jsqte) Then
CL_PzAss.lab_GridRow = Dqpdwgh
Call Kmfzhsx(Dqpdwgh)
' 判断用户录入数量单价是否为零，如不为零则由数量*单价=金额
' (考虑销售收入主要为贷方则借贷金额均为零时,金额自动填入贷方)
If Val(WglrGrid.TextMatrix(Dqpdwgh, 5)) <> 0 And Val(WglrGrid.TextMatrix(Dqpdwgh, 6)) <> 0 Then
If Val(Trim(WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)))) <> 0 Then
WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 5)) * Val(WglrGrid.TextMatrix(Dqpdwgh, 6)), "##." + String(Xtjexsws, "0"))
Else
WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 5)) * Val(WglrGrid.TextMatrix(Dqpdwgh, 6)), "##." + String(Xtjexsws, "0"))
End If
End If
' 判断用户录入外币汇率是否为零，如不为零则由外币*汇率=金额
' (借贷金额均为零时,金额自动填入借方)
If Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) <> 0 And Val(WglrGrid.TextMatrix(Dqpdwgh, 11)) <> 0 Then
If Val(Trim(WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)))) <> 0 Then
'判断外币折算方式
If Rectemp.Fields("ConVertFlag") Then
WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) / Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
Else
WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) * Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
End If
Else
'判断外币折算方式
If Rectemp.Fields("ConVertFlag") Then
WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) / Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
Else
WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, 10)) * Val(WglrGrid.TextMatrix(Dqpdwgh, 11)), "##." + String(Xtjexsws, "0"))
End If
End If
End If
Exit For
End If
Next Jsqte
End If
End With
' 计算合计数据
For Coljsq = Qslz To WglrGrid.Cols - 1
Call Sjhj(Coljsq)
Next Coljsq
'重新显示辅助核算信息
Call Sub_ShowMemo(WglrGrid.Row)
End If
End Sub
Private Sub Kmfzhsx(Lng_GridRow As Long) '调用科目辅助核算项
'过程函数;Lng_gridrow当前网格调入辅助核算行
Dim Kjqstop#, Kjqsleft#, Kjjg#, Ctzxgd#, Kjxsgs%, Jsqte%
Dim Rectemp As New ADODB.Recordset '临时使用动态集
Kjqstop = 300 '控件显示起始高度
Kjqsleft = 300 '控件显示起始左边界
Kjjg = 450 '控件显示间隔
Kjxsgs = 0 '控件显示个数
Ctzxgd = 1500 '窗体显示最小高度
With CL_PzAss '辅助核算项目窗体
.Caption = "辅助核算项目_" + Trim(WglrGrid.TextMatrix(Lng_GridRow, Sydz("003", GridStr(), Szzls)))
For Jsqte = 0 To Int_AssCount - 1
If Bln_AssShow(Jsqte) Then
.tsLabel(Jsqte).Visible = True
.tsLabel(Jsqte).Move Kjqsleft, Kjqstop + Kjxsgs * Kjjg
.LrText(Jsqte).Visible = True
.LrText(Jsqte).Move .tsLabel(Jsqte).Left + .tsLabel(Jsqte).Width + 50, .tsLabel(Jsqte).Top - 100
If Bln_AssHelp(Jsqte) Then
.Ydcommand1(Jsqte).Visible = True
.Ydcommand1(Jsqte).Move .LrText(Jsqte).Left + .LrText(Jsqte).Width, .LrText(Jsqte).Top, .Ydcommand1(Jsqte).Width, .LrText(Jsqte).Height
End If
Kjxsgs = Kjxsgs + 1
Select Case Jsqte
Case 0 '结算方式
.LrText(Jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 1))
.LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 2))
Case 1 '票号
.LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 3))
Case 2 '发生日期
.LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 4))
Case 3 '数量
.LrText(Jsqte).Text = WglrGrid.TextMatrix(Lng_GridRow, 5)
.Lab_Measure = Trim(WglrGrid.TextMatrix(Lng_GridRow, 7))