📄 frm_sdgl_add.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form Frm_sdgl_add
BorderStyle = 1 'Fixed Single
Caption = "水电费信息录入"
ClientHeight = 3675
ClientLeft = 45
ClientTop = 330
ClientWidth = 5700
Icon = "Frm_sdgl_add.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3675
ScaleWidth = 5700
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "取消"
Height = 375
Left = 3360
TabIndex = 27
Top = 3120
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 375
Left = 840
TabIndex = 26
Top = 3120
Width = 1215
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 300
Left = 1440
TabIndex = 25
Top = 2640
Width = 1275
_ExtentX = 2249
_ExtentY = 529
_Version = 393216
CustomFormat = "yyyy-MM-dd"
Format = 16711683
CurrentDate = 38809
End
Begin VB.TextBox Text11
Height = 300
Left = 4200
TabIndex = 23
Top = 2220
Width = 1275
End
Begin VB.TextBox Text10
Height = 300
Left = 1440
TabIndex = 21
Top = 2220
Width = 1275
End
Begin VB.TextBox Text9
Height = 300
Left = 4200
TabIndex = 19
Top = 1800
Width = 1275
End
Begin VB.TextBox Text8
Height = 300
Left = 1440
TabIndex = 17
Top = 1800
Width = 1275
End
Begin VB.TextBox Text7
Height = 300
Left = 4200
TabIndex = 15
Top = 1380
Width = 1275
End
Begin VB.TextBox Text6
Height = 300
Left = 1440
TabIndex = 13
Top = 1380
Width = 1275
End
Begin VB.TextBox Text5
Height = 300
Left = 4200
TabIndex = 11
Top = 960
Width = 1275
End
Begin VB.TextBox Text4
Height = 300
Left = 1440
TabIndex = 9
Top = 960
Width = 1275
End
Begin VB.TextBox Text3
Height = 300
Left = 4200
TabIndex = 7
Top = 540
Width = 1275
End
Begin VB.TextBox Text2
Height = 300
Left = 1440
TabIndex = 5
Top = 540
Width = 1275
End
Begin VB.TextBox Text1
Height = 300
Left = 4200
TabIndex = 3
Top = 120
Width = 1275
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1440
Style = 2 'Dropdown List
TabIndex = 1
Top = 120
Width = 1275
End
Begin VB.Label Label14
Caption = "抄表日期"
Height = 255
Left = 180
TabIndex = 24
Top = 2700
Width = 975
End
Begin VB.Label Label13
Caption = "抄表员"
Height = 255
Left = 2940
TabIndex = 22
Top = 2220
Width = 795
End
Begin VB.Label Label12
Caption = "其他公摊"
Height = 315
Left = 180
TabIndex = 20
Top = 2220
Width = 855
End
Begin VB.Label Label11
Caption = "水损公摊"
Height = 315
Left = 2940
TabIndex = 18
Top = 1800
Width = 855
End
Begin VB.Label Label10
Caption = "水泵公摊"
Height = 315
Left = 180
TabIndex = 16
Top = 1800
Width = 915
End
Begin VB.Label Label9
Caption = "电 费"
Height = 255
Left = 2940
TabIndex = 14
Top = 1380
Width = 735
End
Begin VB.Label Label8
Caption = "电表本月读数"
Height = 315
Left = 180
TabIndex = 12
Top = 1380
Width = 1095
End
Begin VB.Label Label7
Caption = "电表上月读数"
Height = 255
Left = 2940
TabIndex = 10
Top = 960
Width = 1155
End
Begin VB.Label Label6
Caption = "水 费"
Height = 255
Left = 180
TabIndex = 8
Top = 960
Width = 615
End
Begin VB.Label Label5
Caption = "水表本月读数"
Height = 255
Left = 2940
TabIndex = 6
Top = 600
Width = 1095
End
Begin VB.Label Label4
Caption = "水表上月读数"
Height = 255
Left = 180
TabIndex = 4
Top = 540
Width = 1155
End
Begin VB.Label Label3
Caption = "综合管理费"
Height = 255
Left = 2940
TabIndex = 2
Top = 180
Width = 975
End
Begin VB.Label Label1
Caption = "房 号"
Height = 255
Left = 180
TabIndex = 0
Top = 180
Width = 615
End
End
Attribute VB_Name = "Frm_sdgl_add"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error GoTo myerr
If Not (IsNumeric(Text1) And IsNumeric(Text2) And IsNumeric(Text3) And IsNumeric(Text4) And IsNumeric(Text5) And IsNumeric(Text6) And IsNumeric(Text7) And IsNumeric(Text8) And IsNumeric(Text9) And IsNumeric(Text10)) Then
MsgBox "请正确输入数值！", vbExclamation, "提示"
Exit Sub
End If
If Val(Text2) > Val(Text3) Then
MsgBox "水表读数输入错误！", vbExclamation, "提示"
Exit Sub
End If
If Val(Text5) > Val(Text6) Then
MsgBox "水表读数输入错误！", vbExclamation, "提示"
Exit Sub
End If
Dim cn As ADODB.Connection
Dim rst As New ADODB.Recordset
Set cn = GetCn
rst.Open "select DATEPART('yyyy',cbrq),DATEPART('m',cbrq),b.fh from jiaofei a inner join fangchan b on a.fid=b.id where a.fid=" & Combo1.ItemData(Combo1.ListIndex), cn, 0, 1
If Not (rst.BOF And rst.EOF) Then
Do While Not rst.EOF
If DTPicker2.Year & DTPicker2.Month = rst(0) & rst(1) Then
MsgBox "该房号该月已录入！", vbExclamation, "提示"
rst.Close
cn.Close
Exit Sub
End If
rst.MoveNext
Loop
End If
cn.Execute "insert into jiaofei (fid,zgf,sbsy,sbby,sf,dbsy,dbby,df,sb,ss,qt,cby,cbrq,yj) values (" & Combo1.ItemData(Combo1.ListIndex) & "," & Trim(Text1) & "," & Trim(Text2) & "," & Trim(Text3) & "," & Trim(Text4) & "," & Trim(Text5) & "," & Trim(Text6) & "," & Trim(Text7) & "," & Trim(Text8) & "," & Trim(Text9) & "," & Trim(Text10) & ",'" & Trim(Text11) & "','" & DTPicker2.Value & "'," & Val(Text1) + Val(Text4) + Val(Text7) + Val(Text8) + Val(Text9) + Val(Text10) & ")"
MsgBox "成功保存！", vbExclamation, "提示"
Unload Me
Exit Sub
myerr:
MsgBox Error, vbExclamation, "提示"
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim cn As ADODB.Connection
Dim rst As New ADODB.Recordset
DTPicker2.Value = Date
Set cn = GetCn
rst.Open "select a.fh,a.id from fangchan a inner join yezhu b on a.id=b.fid ", cn, 0, 1
If rst.BOF And rst.EOF Then
MsgBox "请先建立房产和业主基础数据！", vbExclamation, "提示"
Exit Sub
Command1.Enabled = False
End If
Do While Not rst.EOF
Combo1.AddItem rst(0)
Combo1.ItemData(Combo1.NewIndex) = rst(1)
rst.MoveNext
Loop
Combo1.ListIndex = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -