📄 frmin_kjkmwh.frm
字号:
Text = "预览部分"
EndProperty
EndProperty
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "增加"
Key = "Add"
Object.ToolTipText = "增加"
ImageIndex = 4
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "修改"
Key = "Edit"
ImageIndex = 10
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "删除"
Key = "Delete"
Object.ToolTipText = "删除"
ImageIndex = 5
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保存"
Key = "Save"
Object.ToolTipText = "保存"
ImageIndex = 6
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "取消"
Key = "Cancel"
Object.ToolTipText = "取消"
ImageIndex = 7
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
Key = "Help"
Object.ToolTipText = "帮助"
ImageIndex = 8
EndProperty
BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "Exit"
Object.ToolTipText = "退出"
ImageIndex = 9
EndProperty
EndProperty
BorderStyle = 1
End
Begin VB.Label lblLock
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H00C0FFC0&
BorderStyle = 1 'Fixed Single
Caption = "锁定科目"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 240
Left = 10620
MousePointer = 14 'Arrow and Question
TabIndex = 56
ToolTipText = "点击此处可以获取具体锁定信息."
Top = 630
Visible = 0 'False
Width = 930
End
Begin VB.Label lblUse
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H00C0FFC0&
BorderStyle = 1 'Fixed Single
Caption = "在用科目"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 9405
TabIndex = 35
Top = 630
Visible = 0 'False
Width = 930
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuPrint
Caption = "打印(&P)"
Shortcut = ^P
End
Begin VB.Menu mnuPreview
Caption = "预览(&U)"
End
Begin VB.Menu menumain
Caption = "另存为..."
Begin VB.Menu mnusaveexcel
Caption = "Excel文件"
End
Begin VB.Menu mnusavehtml
Caption = "Html文件"
End
Begin VB.Menu mnusavetxt
Caption = "文本文件"
End
End
Begin VB.Menu mnuDiv1
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "关闭(&X)"
End
End
Begin VB.Menu mnuEdit
Caption = "编辑(&E)"
Begin VB.Menu mnuFind
Caption = "查找(&F)"
Shortcut = ^F
End
Begin VB.Menu mnuDiv3
Caption = "-"
End
Begin VB.Menu mnuNew
Caption = "增加(&N)"
Shortcut = ^N
End
Begin VB.Menu mnuEdits
Caption = "修改(&E)"
Shortcut = ^E
End
Begin VB.Menu mnuDelete
Caption = "删除(&D)"
Shortcut = ^D
End
Begin VB.Menu mnusave
Caption = "保存(&S)"
Shortcut = ^S
End
Begin VB.Menu mnuDiv2
Caption = "-"
End
Begin VB.Menu mnuCancel
Caption = "取消(&C)"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
End
End
Attribute VB_Name = "frmIN_Kjkmwh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private i As Integer
Private Appediflag As Byte '“添加”或“修改”的标志。
Private sCodeLevel As String '编码方案字符串。
Private clsMyNormal As New clsNormal
Private clsOnekjkm As clsDepart
Private adoRst As ADODB.Recordset '连接科目表tZW_Km 年份
Private rstTrade As ADODB.Recordset '连接科目级数系统表tSYS_TradeCodeClass
Private Index As Integer
Dim Iwatch As Integer '
Dim JcWs() As Integer
Dim loadflag() As Boolean '存放tabkm选项卡的每一个选项卡是否被点击过;
Dim Nodestr As String '存放所点击节点的代码
Dim m_sKmdm As String
Dim m_bAddState As Boolean
Dim m_bFirst As Boolean
Dim m_strButtonState As String
Dim m_LockKm As New clsLockKmFunction
Dim m_error As Boolean
Private Sub cboCollectSubject_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub cboWbdw_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub chkCollect_Click()
If chkCollect.value = 1 Then
clsMyNormal.UnlockOneBox cboCollectSubject
Else
clsMyNormal.LockOneBox cboCollectSubject
End If
If Appediflag = 1 Then
If Trim$("" & txtKmdm.text) <> "" Then
cboCollectSubject.AddItem Trim$("" & txtKmdm.text)
End If
End If
End Sub
Private Sub chkYhz_Click()
Dim rstwb3 As ADODB.Recordset
Set rstwb3 = New ADODB.Recordset
If chkYhz.value = 0 Then
rstwb3.CursorLocation = adUseClient
rstwb3.Open " select * from tzw_pzsj" & glo.sOperateYear & " where kjqj=20 and kmdm='" & Right(tvwKm(tabKm.SelectedItem.Index).SelectedItem.Key, Len(tvwKm(tabKm.SelectedItem.Index).SelectedItem.Key) - 1) & "'", glo.cnnMain, adOpenStatic, adLockPessimistic
If rstwb3.RecordCount > 0 Then
MsgBox "银行账已启用！", vbInformation, ""
chkYhz.value = 1
Exit Sub
End If
rstwb3.Close
rstwb3.Open " select * from tzw_yhdzd" & glo.sOperateYear & " where kmdm='" & Right(tvwKm(tabKm.SelectedItem.Index).SelectedItem.Key, Len(tvwKm(tabKm.SelectedItem.Index).SelectedItem.Key) - 1) & "'", glo.cnnMain, adOpenStatic, adLockPessimistic
If rstwb3.RecordCount > 0 Then
MsgBox "有银行方对账单！", vbInformation, ""
chkYhz.value = 1
End If
End If
End Sub
Private Sub CmdAddBz_Click()
frmIN_HL.HelpContextID = 101
frmIN_HL.Show 1
Call RefreshHl
End Sub
Private Sub form_load()
Dim rstJs As ADODB.Recordset
Dim rstwb As ADODB.Recordset
Dim iCount As Integer
Dim ctl As Control
'glo.frmProg.ShowProgress 0
'glo.frmProg.Show
'glo.frmProg.SetMsg "正在装载数据，请稍候 ..."
Set clsOnekjkm = New clsDepart
'lijian * *
ContorlMenu "cancel"
'end * *
'装科目级数(tUSU_DMJS)到数组
Set rstJs = New ADODB.Recordset
rstJs.CursorLocation = adUseClient
rstJs.Open "select Jc,Ws from tUSU_DMJS where type='科目' order by Jc", _
glo.cnnMain, adOpenStatic, adLockOptimistic
ReDim JcWs(rstJs.RecordCount)
For i = 0 To rstJs.RecordCount - 1
JcWs(i) = rstJs.Fields("Ws").value
rstJs.MoveNext
Next i
Set rstJs = Nothing
glo.frmProg.ShowProgress 5
'打开科目表(tZW_Km####)
Set adoRst = New ADODB.Recordset
adoRst.CursorLocation = adUseClient
adoRst.Open "select kmdm,kmmc,kmmceng,zjm,kmlx,kmjc,IsEndkm,yefx,zygs,hzdykm," & _
"sldw,wbdw,IsRjz,IsYhz,IsGrwlhs,IsKhwlhs,IsGyswlhs,IsBmhs,IsXmhs,IsXjllkm," & _
"Xjlllb,Isfc,bUse,bAdd from tZW_Km" & glo.sOperateYear & _
" where kmdm IS NOT NULL and kmdm<>' ' order by kmdm", _
glo.cnnMain, adOpenStatic, adLockOptimistic
glo.frmProg.ShowProgress 15
'打开行业类型表(系统表tSYS_TradeCodeClass)
Set rstTrade = New ADODB.Recordset
rstTrade.CursorLocation = adUseClient
rstTrade.Open "select classserial,classname,yefx from tSYS_tradecodeclass A,tSYS_Account B" & _
" where B.AccountID='" & glo.sAccountID & "'and A.tradeID=B.TradeID", _
gloSys.cnnSYS, adOpenStatic, adLockReadOnly
glo.frmProg.ShowProgress 20
'打开外币种类维护表(tZW_ForeignCurrency)，装入组合框
Set rstwb = New ADODB.Recordset
rstwb.CursorLocation = adUseClient
rstwb.Open "select cExch_Name from tZW_ForeignCurrency" & glo.sOperateYear, _
glo.cnnMain, adOpenStatic, adLockOptimistic
If Not rstwb.BOF Then rstwb.MoveFirst
While Not rstwb.EOF
cboWbdw.AddItem rstwb.Fields(0).value
rstwb.MoveNext
Wend
glo.frmProg.ShowProgress 25
'将由行业类型决定的科目类型填入TabStrip控件，并装入组合框
If rstTrade.RecordCount > 0 Then
tabKm.Tabs(1).Caption = rstTrade.Fields(1)
cboKmlx.AddItem rstTrade.Fields(1)
rstTrade.MoveNext
Do While Not rstTrade.EOF
cboKmlx.AddItem rstTrade.Fields(1)
tabKm.Tabs.Add tabKm.Tabs.Count + 1, , rstTrade.Fields(1)
rstTrade.MoveNext
Loop
End If
Iwatch = rstTrade.RecordCount
glo.frmProg.ShowProgress 30
'置装入标志
ReDim loadflag(Iwatch)
For i = 1 To rstTrade.RecordCount
loadflag(i - 1) = False
Next i
For i = 2 To rstTrade.RecordCount
Load tvwKm(i) '动态创建数组树控件
Next i
clsOnekjkm.LoadAllRoot tvwKm(1), tabKm.Tabs(1), "*", True
loadflag(0) = True
tabKm.ZOrder 1
cboZygs.AddItem "金额式", 0
' cboZygs.AddItem "多栏式", 1
cboZygs.AddItem "外币金额式", 1
cboZygs.AddItem "数量金额式", 2
cboZygs.AddItem "数量外币式", 3
cboXjlb.AddItem "现金", 0
cboXjlb.AddItem "现金等价物", 1
'初始化科目设置对象，包含装入树表的操作。
tvwKm(1).Nodes("R").Selected = True
tbrKm.Buttons("Add").Enabled = False
tbrKm.Buttons("Edit").Enabled = False
tbrKm.Buttons("Delete").Enabled = False
tbrKm.Buttons("Save").Enabled = False
tbrKm.Buttons("Cancel").Enabled = False
mnuNew.Enabled = False
mnuEdits.Enabled = False
mnuDelete.Enabled = False
mnuSave.Enabled = False
mnuCancel.Enabled = False
CmdAddBz.Enabled = False
If glo.sSeparateSubject = "0" Then
'填充编码方案示意文本。
Call FillCodeLevel
Else
sbrKm.Visible = False
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -