📄 +
字号:
VERSION 5.00
Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
Begin VB.Form PZ_FrmKjkmcz
BorderStyle = 3 'Fixed Dialog
Caption = "会计科目编码参照表"
ClientHeight = 6015
ClientLeft = 2430
ClientTop = 1890
ClientWidth = 6420
Icon = "会计科目编码参照(仅限凭证录入).frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6015
ScaleWidth = 6420
ShowInTaskbar = 0 'False
Begin VSFlex8Ctl.VSFlexGrid CzxsGrid
Height = 5040
Left = 75
TabIndex = 7
Top = 450
Width = 6240
_cx = 11007
_cy = 8890
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 = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = -2147483636
BackColorAlternate= -2147483643
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 VB.CheckBox UnloadCheck
Caption = "卸载窗体"
Height = 615
Left = 6930
TabIndex = 6
Top = 2550
Width = 825
End
Begin VB.CommandButton Gridsz
Caption = "恢复默认格式(&U)"
Height = 300
Index = 1
Left = 1920
TabIndex = 5
Top = 5580
Width = 1515
End
Begin VB.CommandButton Gridsz
Caption = "保存表格格式(&S)"
Height = 300
Index = 0
Left = 390
TabIndex = 4
Top = 5580
Width = 1515
End
Begin VB.TextBox CodeText
Height = 300
Left = 1110
TabIndex = 0
Top = 150
Width = 5205
End
Begin VB.CommandButton QxCommand
Cancel = -1 'True
Caption = "取消(&C)"
Height = 300
Left = 4860
TabIndex = 2
Top = 5580
Width = 1120
End
Begin VB.CommandButton QdCommand
Caption = "确定(&O)"
Default = -1 'True
Height = 300
Left = 3690
TabIndex = 1
Top = 5580
Width = 1120
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "编码或名称:"
Height = 180
Index = 0
Left = 90
TabIndex = 3
Top = 210
Width = 990
End
End
Attribute VB_Name = "PZ_FrmKjkmcz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************
'* 模 块 名 称 :会计科目编码参照(仅限于凭证录入使用,为加快调入速度)
'* 功 能 描 述 :
'* 程序员姓名 : 张建忠
'* 最后修改人 : 张建忠
'* 最后修改时间:2000/09/11
'* 备 注:
'* 使用说明： Xtcdcs 用来传递用户输入内容; xtbmczdm 用来传递所选编码参照
' xtfhcs 用来返回用户所选编码; xtfhcsfz 用来返回用户所选名称
'**************************************************************************
Dim Cznr As String '网格首次进入查找内容
'以下为固定使用变量
Dim Cxnrrec As New ADODB.Recordset '显示查询内容动态集
Dim GridCode As String '显示网格网格代码
Dim GridInf() As Variant '整个网格设置信息
Dim Tsxx As String '系统提示信息
Dim Qslz As Long '网格隐藏(非操作显示)列数
Dim Sjhgd As Double '网格数据行高度
Dim GridBoolean() As Boolean '网格列信息(布尔型)
Dim GridStr() As String '网格列信息(字符型)
Dim GridInt() As Integer '网格列信息(整型)
Dim Szzls As Integer '数组总列数(网格列数-1)
Private Sub CodeText_Change() '用户可模糊定位编码或名称信息
Dim DwRow As Long
Dim Lng_BmCol As Long
Dim Lng_McCol As Long
On Error Resume Next
Lng_BmCol = Sydz("001", GridStr(), Szzls)
Lng_McCol = Sydz("002", GridStr(), Szzls)
Cznr = Trim(CodeText.Text)
With CzxsGrid
For DwRow = .FixedRows To .Rows - 1
If Mid(.TextMatrix(DwRow, Lng_BmCol), 1, Len(Cznr)) = Cznr Then
.Row = DwRow
.Col = Lng_BmCol
CzxsGrid.SetFocus
SendKeys "{LEFT}", True
CodeText.SetFocus
.TopRow = DwRow
Exit Sub
End If
Next DwRow
For DwRow = .FixedRows To .Rows - 1
If Mid(.TextMatrix(DwRow, Lng_McCol), 1, Len(Cznr)) = Cznr Then
.Row = DwRow
.Col = Lng_BmCol
CzxsGrid.SetFocus
SendKeys "{LEFT}", True
CodeText.SetFocus
.TopRow = DwRow
Exit Sub
End If
Next DwRow
End With
End Sub
Private Sub CzxsGrid_GotFocus()
SendKeys "{LEFT}", True
End Sub
Private Sub Form_Activate()
CodeText.Text = Trim(Xtcdcs)
CzxsGrid.SetFocus
End Sub
Private Sub Form_Load() '调 入 窗 体
'调 入 网 格
GridCode = "Cwzz_AccCode"
Call Sub_ShowGrid(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Szzls = CzxsGrid.Cols - 1
'填 充 网 格
Call Cxnrtcwg
End Sub
Private Sub Cxnrtcwg() '查 询 内 容 填 充 网 格
Dim Sqlstr As String
Dim jsqte As Long
'查询连接串
Sqlstr = "Select Ccode,Cname,StopFlag From Cwzz_AccCode order by CCode"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With Cxnrrec
CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
If .EOF And .BOF Then
Exit Sub
End If
jsqte = CzxsGrid.FixedRows
Do While Not .EOF
If jsqte >= CzxsGrid.Rows Then
CzxsGrid.AddItem ""
End If
Call Jltcwg(Cxnrrec, jsqte)
CzxsGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
End With
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long) '记录内容填充网格
Dim Str_Fzhs As String '辅助核算
'[以下为自定义部分
With Jlbrec
CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Ccode"))
CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Cname") & "")
If .Fields("StopFlag") Then
CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = "√"
End If
End With
'以上为自定义部分]
End Sub
Private Sub CzxsGrid_DblClick() '用户双击网格返回当前选中编码
Call Fhxzbm
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '判断是否卸载窗体
If UnloadCheck.Value = 1 Then
Unload Me
Else
Cancel = 1
Me.Hide
End If
End Sub
Private Sub Form_Unload(Cancel As Integer) '退出
Set Cxnrrec = Nothing
End Sub
Private Sub Gridsz_Click(Index As Integer)
Select Case Index
Case 0 '保存表格格式
Call Bcwggs1(CzxsGrid, GridCode)
Case 1 '恢复默认格式
Call Hfmrgs1(CzxsGrid, GridCode)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -