📄 frmywadd.frm
字号:
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "归属部门代码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 6240
TabIndex = 27
Top = 1560
Width = 1095
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "资金科目"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3480
TabIndex = 25
Top = 1560
Width = 1095
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "资金类别"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8640
TabIndex = 23
Top = 840
Width = 1455
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "管理部门"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3480
TabIndex = 21
Top = 840
Width = 1095
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "业务金额"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 960
TabIndex = 13
Top = 2280
Width = 1095
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "资金科目代码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 960
TabIndex = 12
Top = 1560
Width = 1095
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "备注"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6360
TabIndex = 9
Top = 2280
Width = 975
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "归属部门"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8640
TabIndex = 8
Top = 1560
Width = 1095
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "资金类别代码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 6240
TabIndex = 6
Top = 840
Width = 1215
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "管理部门代码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 960
TabIndex = 5
Top = 795
Width = 1215
End
Begin VB.Label Lablxr
BackStyle = 0 'Transparent
Caption = "发生日期"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7560
TabIndex = 2
Top = 240
Width = 1095
End
Begin VB.Label Labkhmc
BackStyle = 0 'Transparent
Caption = "票据号码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 960
TabIndex = 1
Top = 240
Width = 1095
End
End
Attribute VB_Name = "frmywadd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As New ADODB.Connection
Dim rskjyw As New ADODB.Recordset
Dim rspzlb As New ADODB.Recordset
Dim rsgkglbm As New ADODB.Recordset
Dim rsyskmlb As New ADODB.Recordset
Dim rsyskm As New ADODB.Recordset
Dim rsfygsbm As New ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim addrecord As Boolean
Private Sub setbuttons(bval As Boolean)
Dim setcontrol As Control
For Each setcontrol In Me.Controls
If TypeName(setcontrol) = "DataCombo" Or TypeName(setcontrol) = "TextBox" Or TypeName(setcontrol) = "CheckBox" Then
setcontrol.Enabled = bval
End If
Next
cmdkjyw(0).Enabled = Not bval
cmdkjyw(1).Enabled = bval
cmdkjyw(2).Enabled = bval
cmdkjyw(3).Enabled = Not bval
DTfsrq.Enabled = bval
Exit Sub
End Sub
'存储新增纪录到历史数据表
Private Sub storehistory()
Dim i As Integer
Dim j As Integer
Dim str As String
If Dacompzhm.Text <> "" Then
history = history & "票据号码(" & Dacompzhm.Text & ")"
End If
If Dacompzlbmc.Text <> "" Then
history = history & "票据类别名称(" & Dacompzlbmc.Text & ")"
End If
If Dacomyslbmc.Text <> "" Then
history = history & "资金科目类别名称(" & Dacomyslbmc.Text & ")"
End If
If Dacomyskmmc.Text <> "" Then
history = history & "资金科目名称(" & Dacomyskmmc.Text & ")"
End If
If Dacomgsbmmc.Text <> "" Then
history = history & "费用归属部门名称(" & Dacomgsbmmc.Text & ")"
End If
If Dacomglbmmc.Text <> "" Then
history = history & "费用管理部门名称(" & Dacomglbmmc.Text & ")"
End If
history = history & "发生日期(" & DTfsrq.Value & ")"
If Dacomywje.Text <> "" Then
history = history & "业务金额(" & Dacomywje.Text & ")"
End If
If txtbz.Text <> "" Then
history = history & "备注(" & txtbz.Text & ")"
End If
conn.Execute ("insert into ywhistory (pzhm,username,act,content,actdate) values('" & Dacompzhm.Text & "','" & username & "','增加','" & history & "','" & Format(Date, "yyyy-MM-dd") & "')")
End Sub
'保存会计业务纪录
Private Function storekjyw() As Boolean
Dim note(10) As String
Dim str As String
Dim gsbmzh As Single
Dim jtzh As Single
Dim gsbmsx As Single
Dim jtsx As Single
Dim i As Single
gsbmje = 0
jtje = 0
jtsx = 0
gsbmsx = 0
note(0) = "票据号码不能为空！"
note(1) = "发生日期不能为空！"
note(2) = "归口管理部门代码和名称不能同时为空！"
note(3) = "资金科目类别代码和名称不能同时为空！"
note(4) = "资金科目代码和名称不能同时为空！"
note(5) = "费用归属部门代码和名称不能同时为空！"
note(6) = "业务金额不能为空！"
note(7) = "该票据号码已经存在！"
note(8) = "票据类别名称不能为空！"
note(9) = "该票据号码的格式不正确！"
storekjyw = False
If Dacompzhm.Text = "" Then
MsgBox note(0)
Dacompzhm.SetFocus
Exit Function
End If
If InStr(Dacompzhm.Text, "-") = 0 Then
MsgBox note(9)
Dacompzhm.SetFocus
Exit Function
End If
If Dacompzlbmc.Text = "" Then
MsgBox note(8)
Dacompzlbmc.SetFocus
Exit Function
End If
If DTfsrq.Value = "" Then
MsgBox note(1)
DTfsrq.SetFocus
Exit Function
End If
If rskjyw.RecordCount = 1 Then
rskjyw.Fields("fsrq").Value = DTfsrq.Value
End If
If Dacomglbmdm.Text = "" And Dacomglbmmc.Text = "" Then
MsgBox note(2)
Dacomglbmdm.SetFocus
Exit Function
End If
If Dacomyslbdm.Text = "" And Dacomyslbmc.Text = "" Then
MsgBox note(3)
Dacomyslbdm.SetFocus
Exit Function
End If
If Dacomyskmdm.Text = "" And Dacomyskmmc.Text = "" Then
MsgBox note(4)
Dacomyskmdm.SetFocus
Exit Function
End If
If Dacomgsbmdm.Text = "" And Dacomgsbmmc.Text = "" Then
MsgBox note(5)
Dacomgsbmdm.SetFocus
Exit Function
End If
If Dacomywje.Text = "" Then
MsgBox note(6)
Dacomywje.SetFocus
Exit Function
End If
Set rs = conn.Execute("select sum(ywje) as jezh from kjyw where yskmmc='" & Dacomyskmmc.Text & "' and gsbmmc='" & Dacomgsbmmc.Text & "'")
If Not rs.EOF Then
gsbmze = rs.Fields("jezh")
Else
gsbmze = 0
End If
rs.Close
Set rs = conn.Execute("select sum(ywje) as jezh from kjyw")
If Not rs.EOF Then
jtze = rs.Fields("jezh")
Else
jtze = 0
End If
rs.Close
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -