📄
字号:
Left = 0
TabIndex = 9
Top = 0
Width = 9240
_ExtentX = 16298
_ExtentY = 1005
ButtonWidth = 820
ButtonHeight = 953
AllowCustomize = 0 'False
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 9
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "设置"
Key = "ymsz"
ImageKey = "sz"
BeginProperty ButtonMenus {66833FEC-8583-11D1-B16A-00C0F0283628}
NumButtonMenus = 1
BeginProperty ButtonMenu1 {66833FEE-8583-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打印"
Key = "dy"
ImageKey = "dy"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "预览"
Key = "yl"
ImageKey = "yl"
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "定义"
Key = "define"
ImageKey = "define"
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "结转"
Key = "run"
ImageKey = "exec"
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
Key = "bz"
ImageKey = "bz"
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "fh"
ImageKey = "tc"
EndProperty
EndProperty
BorderStyle = 1
Begin MSComctlLib.Toolbar GsToolbar
Height = 540
Left = 6630
TabIndex = 10
Top = 0
Width = 2595
_ExtentX = 4577
_ExtentY = 953
ButtonWidth = 1455
ButtonHeight = 953
AllowCustomize = 0 'False
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 3
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保存格式"
Key = "bcgs"
ImageKey = "bcgs"
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "默认列宽"
Key = "hfmrgs"
ImageKey = "mrlk"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "显示项目"
Key = "szxsxm"
ImageKey = "xsxm"
EndProperty
EndProperty
End
End
End
Attribute VB_Name = "JZ_FrmTranList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'* 模 块 名 称 :自动转帐列表
'* 功 能 描 述 :所有通过定义转帐关系能进行自动转帐的目录清单及执行转帐过程
'* 程序员姓名 : 姜冬梅
'* 最后修改人 : 魏永生
'* 最早完成时间:2001/04/30
'* 最近修改时间:2001/11/29
'* 备 注:经过自己测试
'*******************************************************
'修改]
Dim Rec_AutoTranMain As New ADODB.Recordset '转帐过程主表中
Dim Rec_AutoTranItem As New ADODB.Recordset '转帐过程辅表
Dim RecTemp As New ADODB.Recordset '临时数据表
Dim SqlStr As String '查询字符串
Dim Jsqte As Long '临时计数器
'
Dim Je As Double '取金额
Dim Jhj As Double '借合计金额
Dim Dhj As Double '贷合计金额
Dim Sl As Double '取数量
Dim Jhjsl As Double '借合计数量
Dim Dhjsl As Double '贷合计数量
Dim ItemSl As Double '取数量
Dim JhjItemSl As Double '借合计数量
Dim DhjItemSl As Double '贷合计数量
Dim OperationNum As Integer '本次转帐操作批号
Dim Jsq_Eff As Integer '本批有效转帐过程总数
Dim TranJsq As Integer '本批选择的转帐过程个数计数器
Dim TranNum() As String '转帐过程数组
Dim TranVouchClass() As String '转帐凭证类别数组
Dim Bln_DeleteFlag As Boolean '转帐后是否删除临时表
Dim Int_Year As Integer '会计年份
Dim Int_Period As Integer '会计期间
Dim jdzygs As Integer '控件焦点转移个数
Dim Lrzt As Integer '录入状态标志(0-非录入状态 1-增加 2-修改)
Dim ReportTitle As String '报表主标题
Public TranClassCode As String '转帐类型编码
'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset '显示查询内容动态集
Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
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)
'以下为固定使用变量(文本框)
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 '文本框录入有效性判断控制锁,=True时光标离开不需要马上进行判断
Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
jdzygs = 6
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()
'报表主标题及报表编码
ReportTitle = "结转生产成本"
XtReportCode = "CB_CostCarryForward"
Load Dyymctbl
'调入网格
GridCode = "CB_CostCarryForward" '网格属性编码
Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Szzls = CzxsGrid.Cols - 1
'填 充 网 格
Call Cxnrtcwg
'[自定义
'填充会计期间列表框(年度默认为用户选择年度)
Call Sub_FillPeriod(Combo_KJQJ, Xtyear, Xtmm)
'自定义]
End Sub
Private Sub Cxnrtcwg() '查询内容填充网格
SqlStr = "Select A.Objectcode,ObjectName,UnitName,Quantity,ThmonCost,TranEngSign From Cb_ObjectComplete A " _
& "Left Outer Join (Select ObjectCode,ObjectName,UnitName From Cb_CostObject A " _
& "Left Outer Join Gy_UnitSet B On A.MeasureUnitCode=B.UnitCode) B On A.ObjectCode=B.ObjectCode"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With RecTemp
CzxsGrid.Clear 1
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(RecTemp, Jsqte)
CzxsGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Jsqte = Jsqte + 1
Loop
End With
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long) '记录内容填充网格
With Jlbrec
CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Objectcode"))
CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("ObjectName"))
CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("UnitName") & "")
CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Quantity") & "")
CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("ThmonCost") & "")
CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Auditing") & "")
End With
End Sub
Private Sub Wbkcsh() '录入文本框初始化
Dim Jsqte As Integer
'最大录入文本框索引值
Max_Text_Index = Textvar(1)
ReDim TextValiJudgeLock(Max_Text_Index)
For Jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then '如果文本框索引值不为0，即不是“编码”文本框
If Textboolean(Jsqte, 1) Then '如果该文本框处需要提供帮助
If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then '
Load Ydcommand1(Jsqte)
End If
Ydcommand1(Jsqte).Visible = True
Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
End If
TextChangeLock = True
LrText(Jsqte).Text = ""
LrText(Jsqte).Tag = ""
If Textint(Jsqte, 5) <> 0 Then '如果字段录入长度不等于0
LrText(Jsqte).MaxLength = Textint(Jsqte, 5) '该文本框的最大录入长度赋值给文本框的MaxLength
End If
TextChangeLock = False
End If
TextValiJudgeLock(Jsqte) = True
Next Jsqte
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
TranClassCode = ""
Set Cxnrrec = Nothing
Unload Dyymctbl
Set Rec_AutoTranMain = Nothing
Set Rec_AutoTranItem = Nothing
Set RecTemp = Nothing
End Sub
Private Function Bclrsj() As Boolean '判断录入数据有效性,并保存数据
Dim Jsqte As Integer
For Jsqte = 0 To Max_Text_Index
If Textint(Jsqte, 8) = 1 Then '如果字段不能为空
If Len(Trim(LrText(Jsqte).Text)) = 0 Then
Tsxx = Textstr(Jsqte, 7) & "不能为空!"
Call Xtxxts(Tsxx, 0, 1)
LrText(Jsqte).SetFocus
Bclrsj = False
Exit Function
End If
Else
If Textint(Jsqte, 8) = 2 Then '如果字段不能为零
If Val(Trim(LrText(Jsqte).Text)) = 0 Then
Tsxx = Textstr(Jsqte, 7) & "不能为零!"
Call Xtxxts(Tsxx, 0, 1)
LrText(Jsqte).SetFocus
Bclrsj = False
Exit Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -