📄 frm_sdgl_edit.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form Frm_sdgl_edit
BorderStyle = 1 'Fixed Single
Caption = "水电信息修改"
ClientHeight = 3225
ClientLeft = 45
ClientTop = 330
ClientWidth = 5550
Icon = "Frm_sdgl_edit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3225
ScaleWidth = 5550
StartUpPosition = 1 '所有者中心
Begin VB.ComboBox Combo1
Height = 300
Left = 1380
Style = 2 'Dropdown List
TabIndex = 14
Top = 120
Width = 1275
End
Begin VB.TextBox Text1
Height = 300
Left = 4140
TabIndex = 13
Top = 120
Width = 1275
End
Begin VB.TextBox Text2
Height = 300
Left = 1380
TabIndex = 12
Top = 540
Width = 1275
End
Begin VB.TextBox Text3
Height = 300
Left = 4140
TabIndex = 11
Top = 540
Width = 1275
End
Begin VB.TextBox Text4
Height = 300
Left = 1380
TabIndex = 10
Top = 960
Width = 1275
End
Begin VB.TextBox Text5
Height = 300
Left = 4140
TabIndex = 9
Top = 960
Width = 1275
End
Begin VB.TextBox Text6
Height = 300
Left = 1380
TabIndex = 8
Top = 1380
Width = 1275
End
Begin VB.TextBox Text7
Height = 300
Left = 4140
TabIndex = 7
Top = 1380
Width = 1275
End
Begin VB.TextBox Text8
Height = 300
Left = 1380
TabIndex = 6
Top = 1800
Width = 1275
End
Begin VB.TextBox Text9
Height = 300
Left = 4140
TabIndex = 5
Top = 1800
Width = 1275
End
Begin VB.TextBox Text10
Height = 300
Left = 1380
TabIndex = 4
Top = 2220
Width = 1275
End
Begin VB.TextBox Text11
Height = 300
Left = 4140
TabIndex = 3
Top = 2220
Width = 1275
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 375
Left = 2940
TabIndex = 1
Top = 2700
Width = 915
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "取消"
Height = 375
Left = 4320
TabIndex = 0
Top = 2700
Width = 975
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 300
Left = 1380
TabIndex = 2
Top = 2640
Width = 1275
_ExtentX = 2249
_ExtentY = 529
_Version = 393216
CustomFormat = "yyyy-MM-dd"
Format = 16711683
CurrentDate = 38809
End
Begin VB.Label Label1
Caption = "房 号"
Height = 255
Left = 120
TabIndex = 27
Top = 180
Width = 615
End
Begin VB.Label Label3
Caption = "综合管理费"
Height = 255
Left = 2880
TabIndex = 26
Top = 180
Width = 975
End
Begin VB.Label Label4
Caption = "水表上月读数"
Height = 255
Left = 120
TabIndex = 25
Top = 540
Width = 1155
End
Begin VB.Label Label5
Caption = "水表本月读数"
Height = 255
Left = 2880
TabIndex = 24
Top = 600
Width = 1095
End
Begin VB.Label Label6
Caption = "水 费"
Height = 255
Left = 120
TabIndex = 23
Top = 960
Width = 615
End
Begin VB.Label Label7
Caption = "电表上月读数"
Height = 255
Left = 2880
TabIndex = 22
Top = 960
Width = 1155
End
Begin VB.Label Label8
Caption = "电表本月读数"
Height = 315
Left = 120
TabIndex = 21
Top = 1380
Width = 1095
End
Begin VB.Label Label9
Caption = "电 费"
Height = 255
Left = 2880
TabIndex = 20
Top = 1380
Width = 735
End
Begin VB.Label Label10
Caption = "水泵公摊"
Height = 315
Left = 120
TabIndex = 19
Top = 1800
Width = 915
End
Begin VB.Label Label11
Caption = "水损公摊"
Height = 315
Left = 2880
TabIndex = 18
Top = 1800
Width = 855
End
Begin VB.Label Label12
Caption = "其他公摊"
Height = 315
Left = 120
TabIndex = 17
Top = 2220
Width = 855
End
Begin VB.Label Label13
Caption = "抄表员"
Height = 255
Left = 2880
TabIndex = 16
Top = 2220
Width = 795
End
Begin VB.Label Label14
Caption = "抄表日期"
Height = 255
Left = 120
TabIndex = 15
Top = 2700
Width = 975
End
End
Attribute VB_Name = "Frm_sdgl_edit"
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),id from jiaofei where 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) And Not rst(2) = Frm_sdgl.ListView1.SelectedItem.SubItems(15) Then
MsgBox "该房号该月已录入！", vbExclamation, "提示"
rst.Close
cn.Close
Exit Sub
End If
rst.MoveNext
Loop
End If
rst.Close
cn.Execute "update jiaofei set fid=" & Combo1.ItemData(Combo1.ListIndex) & ",zgf=" & Trim(Text1) & ",sbsy=" & Trim(Text2) & ",sbby=" & Trim(Text3) & ",sf=" & Trim(Text4) & ",dbsy=" & Trim(Text5) & ",dbby=" & Trim(Text6) & ",df=" & Trim(Text7) & ",sb=" & Trim(Text8) & ",ss=" & Trim(Text9) & ",qt=" & Trim(Text10) & ",cby='" & Trim(Text11) & "',cbrq='" & DTPicker2 & "',yj=" & Val(Text1) + Val(Text4) + Val(Text7) + Val(Text8) + Val(Text9) + Val(Text10) & " where id=" & Frm_sdgl.ListView1.SelectedItem.SubItems(15)
MsgBox "成功保存！", vbExclamation, "提示"
rst.Open "select xm from yezhu where fid=" & Combo1.ItemData(Combo1.ListIndex), cn, 0, 1
Frm_sdgl.ListView1.SelectedItem.SubItems(1) = rst(0)
Frm_sdgl.ListView1.SelectedItem.Text = Combo1
Frm_sdgl.ListView1.SelectedItem.SubItems(2) = Text1
Frm_sdgl.ListView1.SelectedItem.SubItems(3) = Text2
Frm_sdgl.ListView1.SelectedItem.SubItems(4) = Text3
Frm_sdgl.ListView1.SelectedItem.SubItems(5) = Text4
Frm_sdgl.ListView1.SelectedItem.SubItems(6) = Text5
Frm_sdgl.ListView1.SelectedItem.SubItems(7) = Text6
Frm_sdgl.ListView1.SelectedItem.SubItems(8) = Text7
Frm_sdgl.ListView1.SelectedItem.SubItems(9) = Text8
Frm_sdgl.ListView1.SelectedItem.SubItems(10) = Text9
Frm_sdgl.ListView1.SelectedItem.SubItems(11) = Text10
Frm_sdgl.ListView1.SelectedItem.SubItems(13) = Text11
Frm_sdgl.ListView1.SelectedItem.SubItems(14) = DTPicker2.Value
rst.Close
cn.Close
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 = Frm_sdgl.ListView1.SelectedItem.Text
Text1 = Frm_sdgl.ListView1.SelectedItem.SubItems(2)
Text2 = Frm_sdgl.ListView1.SelectedItem.SubItems(3)
Text3 = Frm_sdgl.ListView1.SelectedItem.SubItems(4)
Text4 = Frm_sdgl.ListView1.SelectedItem.SubItems(5)
Text5 = Frm_sdgl.ListView1.SelectedItem.SubItems(6)
Text6 = Frm_sdgl.ListView1.SelectedItem.SubItems(7)
Text7 = Frm_sdgl.ListView1.SelectedItem.SubItems(8)
Text8 = Frm_sdgl.ListView1.SelectedItem.SubItems(9)
Text9 = Frm_sdgl.ListView1.SelectedItem.SubItems(10)
Text10 = Frm_sdgl.ListView1.SelectedItem.SubItems(11)
Text11 = Frm_sdgl.ListView1.SelectedItem.SubItems(13)
DTPicker2 = Frm_sdgl.ListView1.SelectedItem.SubItems(14)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -