📄 frmysadd.frm
字号:
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 = 1605
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 = 4560
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 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
dalistscbm.Enabled = bval
cmdadd(0).Enabled = Not bval
cmdadd(1).Enabled = bval
cmdadd(2).Enabled = bval
cmdadd(3).Enabled = Not bval
DTfsrj.Enabled = bval
Exit Sub
End Sub
'保存合同纪录
Private Function storekjyw() As Boolean
Dim note(8) As String
Dim str As String
note(0) = "凭证号码不能为空！"
note(1) = "发生日期不能为空！"
note(2) = "归口管理部门代码和名称不能同时为空！"
note(3) = "预算科目类别代码和名称不能同时为空！"
note(4) = "预算科目代码和名称不能同时为空！"
note(5) = "费用归属部门代码和名称不能同时为空！"
note(6) = "业务金额不能为空！"
note(7) = "该凭证号码已经存在！"
storekjyw = False
If Dacompzhm.Text = "" Then
MsgBox note(0)
Dacompzhm.SetFocus
Exit Function
End If
If DTfsrq.Text = "" Then
MsgBox note(1)
DTfsrq.SetFocus
Exit Function
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
If addrecord = 1 Then
Set rs = conn.Execute("select * from kjyw where pzhm=" & Val(Dacomhtmc.Text))
Else
Set rs = conn.Execute("select * from kjyw where pzhm=" & Val(Dacomhtmc.Text) & "' and xuhao=" & rskjyw.Fields("xuhao"))
End If
If Not rs.EOF Then
MsgBox note(7)
Dacompzhm.SetFocus
Exit Function
End If
storekjyw = True
Exit Function
End Function
Private Sub cmdkjyw_Click(Index As Integer)
Select Case Index
Case 0 '添加、修改或删除
If cmdkjyw(Index).Caption = "添加" Then
addrecord = True
setbuttons True
rskjyw.AddNew
Else
If cmdkjyw(Index).Caption = "修改" Then
addrecord = False
setbuttons True
Else '删除
conn.Execute ("delete from kjyw where xuhao=" & rskjyw.Fields("xuhao"))
rskjyw.Requery
Exit Sub
End If
End If
Dacompzhm.SetFocus
Exit Sub
Case 1 '保存
If storekjyw = True Then
'If addrecord = True Then
rskjyw.UpdateBatch adAffectCurrent
setbuttons False
rskjyw.Requery
MsgBox "保存成功！"
'Else
'End If
'setbuttons False
'storehistory
'adorefresh
'conn.Execute ("insert into hthistory (username,act,content,date) values('" & yhmc & "','增加','','" & Date & "')")
End If
Exit Sub
Case 2 '取消
setbuttons False
Exit Sub
Case 3 '退出
Unload Me
End Select
End Sub
Private Sub Form_Load()
Dim fieldname(8) As Variant
Dim wide(8) As Variant
Dim str As String
fieldname(0) = "序号"
fieldname(1) = "凭证号码"
fieldname(2) = "发生日期"
fieldname(3) = "归口管理部门代码"
fieldname(4) = "归口管理部门"
fieldname(5) = "预算科目类别代码"
fieldname(6) = "预算科目类别"
fieldname(7) = "预算科目代码"
fieldname(8) = "预算科目名称"
fieldname(9) = "费用归属部门代码"
fieldname(10) = "费用归属部门"
fieldname(11) = "业务金额"
fieldname(12) = "备注"
wide(0) = 400
wide(1) = 800
wide(2) = 1400
wide(3) = 1000
wide(4) = 1800
wide(5) = 1800
wide(6) = 1800
wide(7) = 1800
wide(8) = 1800
wide(9) = 1800
wide(10) = 1800
wide(11) = 1800
wide(12) = 1800
'str = "Provider=SQLOLEDB.1;Password=090309;Persist Security Info=True;User ID=cw;Initial Catalog=ysgl2004;Data Source=CWSERVER"
If conn.State <> 1 Then
conn.CursorLocation = adUseClient
conn.Open nowconnectstring
End If
str = "SELECT a.xuhao, a.pzhm, a.fsrq, b.dm AS yskmlbdm, a.yslbmc, c.dm AS yskmdm,a.yskmmc, d.dm AS gsbmdm, a.gsbmmc, a.ywje, a.bz FROM kjyw a INNER JOIN yskmlb b ON a.yslbmc = b.yslbmc INNER JOIN yskm c ON a.yskmmc = c.yskmmc INNER JOIN fygsbm d ON a.gsbmmc = d.gsbmmc ORDER BY a.pzhm"
rskjyw.Open str, conn, adOpenStatic, adLockBatchOptimistic
rsyskm.Open "select * from yskm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsyskmlb.Open "select * from yskmlb order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsfygsbm.Open "select * from fygsbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsgkglbm.Open "select * from gkglbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
Set DataGrid1.DataSource = rskjyw
For i = 0 To 12
DataGrid1.Columns(i).Caption = fieldname(i)
DataGrid1.Columns(i).Width = wide(i)
DataGrid1.Columns(i).DataField = rszjsx.Fields(i).Name
Next i
Set Dacompzhm.DataSource = rskjyw
Dacompzhm.DataField = rskjyw.Fields("pzhm").Name
'Set Dacompzhm.RowSource = rskjyw
'Dacomyskmdm.ListField = rskjyw.Fields("dm").Name
Set DTfsrq.DataSource = rskjyw
DTfsrq.DataField = rskjyw.Fields("fsrq").Name
Set Dacomglbmdm.RowSource = rsgkglbm
Dacomglbmdm.ListField = rsgkglbm.Fields("dm").Name
Set Dacomglbmmc.DataSource = rskjyw
Dacomglbmmc.DataField = rskjyw.Fields("glbmmc").Name
Set Dacomyskmmc.RowSource = rsyskm
Dacomyskmmc.ListField = rsyskm.Fields("yskmmc").Name
Set Dacomyslbdm.RowSource = rsyskmlb
Dacomyslbdm.ListField = rsyskmlb.Fields("dm").Name
Set Dacomyslbmc.DataSource = rskjyw
Dacomyslbmc.DataField = rskjyw.Fields("yslbmc").Name
Set Dacomyslbmc.RowSource = rsyskmlb
Dacomyslbmc.ListField = rsyskmlb.Fields("yslbmc").Name
Set Dacomyskmdm.RowSource = rsyskm
Dacomyskmdm.ListField = rsyskm.Fields("dm").Name
Set Dacomyskmmc.DataSource = rskjyw
Dacomyskmmc.DataField = rskjyw.Fields("yskmmc").Name
Set Dacomyskmmc.RowSource = rsyskm
Dacomyskmmc.ListField = rsyskm.Fields("yskmmc").Name
Set Dacomgsbmdm.RowSource = rsfygsbm
Dacomgsbmdm.ListField = rsfygsbm.Fields("dm").Name
Set Dacomgsbmmc.DataSource = rskjyw
Dacomgsbmmc.DataField = rskjyw.Fields("gsbmmc").Name
Set Dacomgsbmmc.RowSource = rsfygsbm
Dacomgsbmmc.ListField = rsfsgsbm.Fields("gsbmmc").Name
Set Dacomywje.DataSource = rskjyw
Dacomywje.DataField = rskjyw.Fields("ywje").Name
Set txtbz.DataSource = rskjyw
txtbz.DataField = rskjyw.Fields("bz").Name
End Sub
Private Sub Label8_Click()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -