📄
字号:
KeyAscii = 0
End If
Case 39 '屏蔽字符"'"
KeyAscii = 0
End Select
End Sub
Private Sub Form_Load() '窗 体 装 入
'初始化各种锁值
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
TranClassCode = AutoTran_TranList.TranClassCode
Changelock = False '网格行列改变控制锁
Gdtlock = False '滚动条滚动控制
Yxxpdlock = True '字段有效性判断锁
Hyxxpdlock = True '行有效性判断锁
Wbkbhlock = False '文本框内容改变锁
'[>>开始 设置辅助核算项目属性
Int_AssCount = 5
ReDim Bln_AssShow(Int_AssCount - 1)
ReDim Bln_AssHelp(Int_AssCount - 1)
Bln_AssHelp(0) = True '个人
Bln_AssHelp(1) = True '部门
Bln_AssHelp(2) = True '项目
Bln_AssHelp(3) = True '客户
Bln_AssHelp(4) = True '供应
'完毕<<]
'报表主标题及报表编码
ReportTitle = "自定义转帐凭证"
XtReportCode = "cwzz_AutoAccDefiMy"
Load Dyymctbl
'调 入 网 格
GridCode = "cwzz_AutoAccDefiMy" '网格属性编码
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
For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
WglrGrid.RowHeight(Jsqte) = Sjhgd
Next Jsqte
'[
ReDim Help_Bz_Col(Szzls)
For Jsqte = 1 To Szzls
Help_Bz_Col(Jsqte) = False
Next Jsqte
Help_Bz_Col(Sydz("010", GridStr(), Szzls)) = True '辅助信息列不能编辑但需要帮助
']
'单据变动置为False
Bln_BillChange = False
'装入会计科目编码帮助窗体(为加快参照速度)PZ_FrmKjkmcz
Load PZ_FrmKjkmcz
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
'卸载打印页面窗体
Unload Dyymctbl
'卸载会计科目编码参照窗体
PZ_FrmKjkmcz.UnloadCheck.Value = 1
Unload PZ_FrmKjkmcz
'判断凭证是否发生变化
If Bln_BillChange Then
Xtfhcs = "1"
Else
Xtfhcs = "0"
End If
Set Rec_AutoTranItem = Nothing
Set RecTemp = Nothing
End Sub
Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal col As Long)
With WglrGrid
If Help_Bz_Col(.col) = True And Lab_OperStatus.Caption = 3 And Yd_Help.Visible = True Then
Call Yd_Help_Show
End If
End With
End Sub
Private Sub Yd_Help_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not Yd_Help.Visible Then
Exit Sub
End If
With WglrGrid
Call Yd_Help_content
End With
WglrGrid.SetFocus
End Sub
Private Sub Timer1_Timer() '根据不同凭证或单据状态处理不同的数据初始化
'关闭定时器
Timer1.Enabled = False
'调入数据初始化模块
Call Sjcsh(Trim(1)) '读入转帐编码\转帐名称\转帐凭证类别
End Sub
Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
Select Case Str_Pzclzt
Case 1 '单据处于编辑状态
With AutoTran_TranList.CzxsGrid
Lbl_AutoAccCode.Caption = .Tag
End With
SqlStr = "SELECT Cwzz_AutoTranMain.VouchClassCode, Cwzz_VouchClass.VouchClassName, " & _
" Cwzz_AutoTranMain.TranName , Cwzz_AutoTranMain.TranCode FROM Cwzz_AutoTranMain " & _
"left OUTER JOIN Cwzz_VouchClass ON " & _
"Cwzz_VouchClass.VouchClassCode = Cwzz_AutoTranMain.VouchClassCode where TranCode='" & Lbl_AutoAccCode.Caption & "' and TranClass='" & TranClassCode & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
Lbl_AutoAccName.Caption = Trim(RecTemp.Fields("TranName"))
Lbl_AutoAccClassCode.Caption = Trim(RecTemp.Fields("VouchClassCode"))
Lbl_AutoAccClassName.Caption = Trim(RecTemp.Fields("VouchClassName"))
RecTemp.Close
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
'设置工具条状态
Call Sub_OperStatus("11")
'显示整张单据信息
Call Sub_ShowBill
Call Sub_AdjustGrid
Case 2 '单据处于浏览状态
Case 3
End Select
End Sub
Private Sub Sub_ShowBill() '根据当前单据号显示整张单据内容
If RecTemp.State = 1 Then RecTemp.Close
SqlStr = "SELECT Cwzz_AutoTranItem.AutoTranID, Cwzz_AutoTranItem.TranCode," & _
"Cwzz_AutoTranItem.Digest, Cwzz_AccCode.Cname, Cwzz_AutoTranItem.TranOri," & _
"Cwzz_AutoTranItem.TranProp, Cwzz_AutoTranItem.PersonCode," & _
"Gy_Person.PersonName, Cwzz_AutoTranItem.Suppliercode," & _
"Gy_supplier.SupplierName, Cwzz_AutoTranItem.CusCode, Gy_Customer.CusName," & _
"Cwzz_AutoTranItem.DeptCode, Gy_Department.DeptName," & _
"Cwzz_AutoTranItem.ItemClassCode, Cwzz_ItemClass.ItemClassName," & _
"Cwzz_AutoTranItem.ItemCode, Cwzz_Item.ItemName, Cwzz_Item.QuantityFlag," & _
"Cwzz_AutoTranItem.GetCcode, Cwzz_AccCode1.Cname AS getname," & _
"Cwzz_AccCode1.PersonFlag, Cwzz_AccCode1.CusFlag," & _
"Cwzz_AccCode1.SupplierFlag, Cwzz_AccCode1.DeptFlag," & _
"Cwzz_AutoTranItem.DistriProp, Cwzz_AutoTranItem.Formulastring," & _
"cwzz_Formula.FormulaName, Cwzz_AutoTranItem.Ccode, Cwzz_AccCode.EndFlag," & _
"Cwzz_AccCode1.ItemFlag , Cwzz_AutoTranItem.TranClass FROM Cwzz_AutoTranItem LEFT OUTER JOIN" & _
" Cwzz_AccCode ON Cwzz_AutoTranItem.Ccode = Cwzz_AccCode.Ccode LEFT OUTER JOIN " & _
"Cwzz_ItemClass ON Cwzz_AutoTranItem.ItemClassCode = Cwzz_ItemClass.ItemClassCode LEFT OUTER JOIN " & _
"Cwzz_Item ON Cwzz_AutoTranItem.ItemClassCode = Cwzz_Item.ItemClassCode AND " & _
"Cwzz_AutoTranItem.ItemCode = Cwzz_Item.ItemCode LEFT OUTER JOIN" & _
" cwzz_Formula ON Cwzz_AutoTranItem.FormulaCode = cwzz_Formula.FormulaCode LEFT OUTER JOIN" & _
" Gy_Department ON Cwzz_AutoTranItem.DeptCode = Gy_Department.DeptCode " & _
" LEFT OUTER JOIN Gy_supplier ON Cwzz_AutoTranItem.Suppliercode = Gy_supplier.SupplierCode " & _
" LEFT OUTER JOIN Gy_Person ON Cwzz_AutoTranItem.PersonCode = Gy_Person.PersonCode" & _
" LEFT OUTER JOIN Gy_Customer ON Cwzz_AutoTranItem.CusCode = Gy_Customer.CusCode " & _
" LEFT OUTER JOIN Cwzz_AccCode Cwzz_AccCode1 ON Cwzz_AutoTranItem.GetCcode = Cwzz_AccCode1.Ccode" & _
" where TranCode='" & Lbl_AutoAccCode.Caption & "' and tranclass='" & TranClassCode & "' order by AutoTranId"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With RecTemp
WglrGrid.Clear 1
If .EOF Then
Exit Sub
Else
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("PersonCode") & "") '个人编码
WglrGrid.TextMatrix(Jsqte, 2) = Trim(.Fields("PersonName") & "") '个人名称
WglrGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("DeptCode") & "") '部门编码
WglrGrid.TextMatrix(Jsqte, 4) = Trim(.Fields("DeptName") & "") '部门名称
WglrGrid.TextMatrix(Jsqte, 5) = Trim(.Fields("CusCode") & "") '客户编码
WglrGrid.TextMatrix(Jsqte, 6) = Trim(.Fields("CusName") & "") '客户名称
WglrGrid.TextMatrix(Jsqte, 7) = Trim(.Fields("Suppliercode") & "") '供应商编码
WglrGrid.TextMatrix(Jsqte, 8) = Trim(.Fields("SupplierName") & "") '供应商名称
WglrGrid.TextMatrix(Jsqte, 9) = Trim(.Fields("ItemClassCode") & "") '项目类别编码
WglrGrid.TextMatrix(Jsqte, 10) = Trim(.Fields("ItemClassName") & "") '项目类别名称
WglrGrid.TextMatrix(Jsqte, 11) = Trim(.Fields("ItemCode") & "") '项目编码
WglrGrid.TextMatrix(Jsqte, 12) = Trim(.Fields("ItemName") & "") '项目名称
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") & "") '科目名称
WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("TranOri")) '转帐方向
WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("TranProp")) '转帐性质
WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("FormulaString") & "") '公式串
Call Sub_ShowMemo(Jsqte)
WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Str_Memo
'<<]
WglrGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Jsqte = Jsqte + 1
Loop
End If
End With
RecTemp.Close
'调整网格,保持1录入行,提供屏幕保持行数.
Call Sub_AdjustGrid
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
'屏蔽文本框,下拉组合框有效性判断,即在网格单元内录入数据时,点帮助信息等,不执行文本框等验证,即不执行YdText或YdCombo的LostFocus事件.
Valilock = True
'屏蔽网格失去焦点产生的有效性判断
Changelock = True
Select Case Button.Key
Case "ymsz" '页面设置
Dyymctbl.Show 1
Case "yl" '预 览
If Fun_Drfrmyxxpd Then Call bbyl(True)
Case "dy" '打 印
If Fun_Drfrmyxxpd Then Call bbyl(False)
Case "xg" '修 改
Call Sub_EditBill
Case "zh" '增 行
Call zjlrfl
Case "sh" '删 行
Call Scdqfl
Case "bc" '保 存
If Fun_Drfrmyxxpd Then Call Sub_SaveBill
Case "fq" '放 弃
Call Sub_AbandonBill
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 'Ctrl的位屏蔽值=2
Select Case UCase(Chr(KeyCode))
Case "P" 'Ctrl+P 打印
If Tlb_Action.Buttons("dy").Enabled Then Call bbyl(False)
End Select
End If
Select Case KeyCode
Case vbKeyF3 '修改凭证
If Tlb_Action.Buttons("xg").Enabled Then
Call Sub_EditBill
End If
Case vbKeyF6 '保存凭证
If Tlb_Action.Buttons("bc").Enabled Then
Call Sub_SaveBill
End If
End Select
End Sub
Private Sub Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
With Tlb_Action
Select Case Str_Status
Case "10" '浏览(系统进入、放弃新增单据、填制凭证时删除单据,凭证审核)
'工具条
.Buttons("dy").Enabled = True '打印
.Buttons("yl").Enabled = True '预览
.Buttons("xg").Enabled = False '修改
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("cx").Enabled = True '查询
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
Case "11" '浏览(放弃修改单据,查询单据)
'工具条
.Buttons("dy").Enabled = True '打印
.Buttons("yl").Enabled = True '预览
.Buttons("xg").Enabled = True '修改
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
Case "30" '修改
'工具条
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
.Buttons("xg").Enabled = False '修改
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -