📄
字号:
Bln_AssHelp(1) = True '部门
Bln_AssHelp(2) = True '项目
Bln_AssHelp(3) = True '客户
Bln_AssHelp(4) = True '供应
'完毕<<]
'报表主标题及报表编码
ReportTitle = "汇兑损益凭证"
XtReportCode = "Cwzz_AutoAccDefiMy"
Load Dyymctbl
'调 入 网 格
GridCode = "Cwzz_AutoAccDefiExchange" '网格属性编码
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("004", 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 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 '单据处于浏览状态
End Select
End Sub
Private Sub Sub_ShowBill() '根据当前单据号显示整张单据内容
If RecTemp.State = 1 Then RecTemp.Close
Sqlstr = "SELECT m.*," & _
"u.PersonName," & _
"o.cname as cname," & _
"t.Suppliername,v.CusName," & _
"s.DeptName," & _
"q.ItemClassName," & _
"r.ItemName, r.QuantityFlag," & _
"o.EndFlag,o.BalanceOri " & _
"FROM Cwzz_AutoTranItem as m LEFT OUTER JOIN" & _
" Cwzz_AccCode as o ON m.Ccode = o.ccode LEFT OUTER JOIN " & _
"Cwzz_ItemClass as q ON m.ItemClassCode = q.ItemClassCode LEFT OUTER JOIN " & _
"Cwzz_Item as r ON m.ItemClassCode = r.ItemClassCode AND " & _
"m.ItemCode = r.ItemCode LEFT OUTER JOIN" & _
" Gy_Department as s ON m.DeptCode = s.DeptCode " & _
" LEFT OUTER JOIN Gy_supplier as t ON m.Suppliercode = t.Suppliercode " & _
" LEFT OUTER JOIN Gy_Person as u ON m.PersonCode = u.PersonCode" & _
" LEFT OUTER JOIN Gy_Customer as v ON m.CusCode = v.CusCode " & _
" 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")) '转帐方向
Call Sub_ShowMemo(Jsqte)
WglrGrid.TextMatrix(Jsqte, Sydz("005", 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 '修改
.Buttons("zh").Enabled = True '增行
.Buttons("sh").Enabled = True '删行
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
End Select
End With
End Sub
Private Sub xswbk() '在当前选中单元显示文本框,列表框,帮助按钮(通用)
Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
'如果单据操作状态为浏览状态则不能显示录入载体
If Trim(Lab_OperStatus.Caption) = "1" Then Exit Sub
'显示文本框前返回有效行列（解决滚动条问题）
Call Xldqh
Call Xldql
'隐藏文本框,帮助按钮,列表组合框 ?何用
Call Ycwbk
With WglrGrid
Dqlrwgh = .Row
Dqlrwgl = .Col
If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then Exit Sub
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
Yd_Help.Visible = False
Else
If GridBoolean(.Col, 2) Then '是否提供帮助
Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -