?? frmuptownmanage.frm
字號:
Begin VB.Label Label11
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "用戶名："
Height = 180
Left = 240
TabIndex = 29
Top = 720
Width = 720
End
Begin VB.Label Label17
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "Label17"
Height = 180
Left = 960
TabIndex = 28
Top = 720
Width = 630
End
Begin VB.Label Label13
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "水 量："
Height = 180
Left = 240
TabIndex = 27
Top = 1200
Width = 720
End
Begin VB.Label Label19
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "Label19"
Height = 180
Left = 960
TabIndex = 26
Top = 1200
Width = 630
End
Begin VB.Label Label14
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "電 量："
Height = 180
Left = 240
TabIndex = 25
Top = 1440
Width = 720
End
Begin VB.Label Label20
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "Label20"
Height = 180
Left = 960
TabIndex = 24
Top = 1440
Width = 630
End
Begin VB.Label Label15
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "氣 量："
Height = 180
Left = 240
TabIndex = 23
Top = 1680
Width = 720
End
Begin VB.Label Label21
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "Label21"
Height = 180
Left = 960
TabIndex = 22
Top = 1680
Width = 630
End
Begin VB.Label Label16
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "合 計："
Height = 180
Left = 240
TabIndex = 21
Top = 2280
Width = 720
End
Begin VB.Label Label22
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "Label22"
Height = 180
Left = 960
TabIndex = 20
Top = 2280
Width = 630
End
Begin VB.Label Label23
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "Label23"
Height = 180
Left = 2160
TabIndex = 19
Top = 2760
Width = 630
End
Begin VB.Label Label12
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "門牌號："
Height = 180
Left = 240
TabIndex = 18
Top = 960
Width = 720
End
Begin VB.Label Label18
AutoSize = -1 'True
BackColor = &H8000000E&
Caption = "Label18"
Height = 180
Left = 960
TabIndex = 17
Top = 960
Width = 630
End
Begin VB.Line Line1
X1 = 240
X2 = 2760
Y1 = 2160
Y2 = 2160
End
End
End
Attribute VB_Name = "UptownManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Adodc1_MoveComplete(ByVal adReason As EventReasonEnum, _
ByVal pError As Error, adStatus As EventStatusEnum, ByVal pRecordset As Recordset)
With Adodc1.Recordset
If Check1.Value = 1 Then
If .AbsolutePosition > 0 Then '顯示當前繳費記錄數據
cmbUser = .Fields("用戶名"): cmbNumber = .Fields("門牌號")
txtWater = .Fields("水"): txtPower = .Fields("電")
txtGas = .Fields("氣"): txtArea = .Fields("物管")
txtDate = .Fields("日期")
Adodc1.Caption = "當前記錄：" & .AbsolutePosition & "/" & .RecordCount
Else
cmbUser = "": cmbNumber = "": txtWater = "": txtPower = ""
txtGas = "": txtArea = "": txtDate = ""
Adodc1.Caption = "無收費記錄"
End If
End If
End With
End Sub
Private Sub Check1_Click()
If Check1.Value = 1 Then
Adodc1.Visible = True '顯示Adodc1導航條
Adodc1.Refresh
txtWP.Visible = False: txtPP.Visible = False '隱藏單價
txtGP.Visible = False: txtAP.Visible = False
Label7.Visible = False: Label8.Visible = False
Label9.Visible = False: Label27.Visible = False
Else
Adodc1.Visible = False '顯示Adodc1導航條
txtWP.Visible = True: txtPP.Visible = True '顯示單價
txtGP.Visible = True: txtAP.Visible = True
Label7.Visible = True: Label8.Visible = True
Label9.Visible = True: Label27.Visible = True
cmbUser = "": cmbNumber = "" '恢復添加收費數據默認狀態
txtWater = "": txtWP = "1.20": txtPower = "": txtPP = "0.50"
txtGas = "": txtGP = "1.00": txtArea = "": txtAP = "0.25"
txtDate = Format(Date, "Long date")
End If
End Sub
Private Sub cmbNumber_Click()
If Check1.Value = 0 Then
cmbUser.ListIndex = cmbNumber.ListIndex '顯示對應的用戶名
txtArea = cmbUser.ItemData(cmbUser.ListIndex) '顯示房屋面積
CheckToPay '檢查是否應該繳費
End If
End Sub
Private Sub cmbUser_click()
If Check1.Value = 0 Then
cmbNumber.ListIndex = cmbUser.ListIndex '顯示對應的用戶名
txtArea = cmbUser.ItemData(cmbUser.ListIndex) '顯示房屋面積
CheckToPay '檢查是否應該繳費
End If
End Sub
Private Sub cmdCalculate_Click()
Dim isOk As Boolean, sglWater!, sglPower!, sglGas!, sglArea!
isOk = Trim(cmbUser) = "" Or Trim(cmbNumber) = "" Or Trim(txtWater) = "" _
Or Trim(txtPower) = "" Or Trim(txtGas) = "" Or Trim(txtArea) = "" _
Or Trim(txtDate) = ""
If Check1.Value = 0 Then
isOk = isOk Or Trim(txtWP) = "" Or Trim(txtPP) = "" Or Trim(txtGP) = "" _
Or Trim(txtAP) = ""
End If
If isOk Then '檢驗數據是否完整
MsgBox "收費記錄各個數據項不能為空白！", vbCritical, "物管收費"
Else
If Check1.Value = 0 Then
Label17 = Trim(cmbUser)
Label18 = Trim(cmbNumber)
sglWater = Val(txtWater) * Val(txtWP)
Label19 = Trim(txtWater) & " * " & Trim(txtWP) & " = " & sglWater
sglPower = Val(txtPower) * Val(txtPP)
Label20 = Trim(txtPower) & " * " & Trim(txtPP) & " = " & sglPower
sglGas = Val(txtGas) * Val(txtGP)
Label21 = Trim(txtGas) & " * " & Trim(txtGP) & " = " & sglGas
sglArea = Val(txtArea) * Val(txtAP)
Label26 = Trim(txtArea) & " * " & Trim(txtAP) & " = " & sglArea
Label22 = sglWater + sglPower + sglGas + sglArea
Label23 = Format(Date, "Long date")
End If
End If
End Sub
Private Sub cmdDelete_Click()
With Adodc1.Recordset
If Not .EOF And Check1.Value = 1 Then
If MsgBox("將刪除<" & Trim(cmbUser) & ">在<" & Trim(txtDate) & _
">的繳費數據，是否繼續？", vbCritical + vbYesNo, "物管收費") = vbYes Then
.Delete adAffectCurrent
.MoveNext
If .EOF And .RecordCount > 0 Then .MoveLast
End If
End If
End With
End Sub
Private Sub cmdParking_Click()
If Label17 = "" Then
MsgBox "當前無票據打印！", vbCritical, "物管收費"
Else
UptownCharge.Label17 = Label17
UptownCharge.Label18 = Label18
UptownCharge.Label19 = Label19
UptownCharge.Label20 = Label20
UptownCharge.Label21 = Label21
UptownCharge.Label26 = Label26
UptownCharge.Label22 = Label22
UptownCharge.Label23 = Label23
UptownCharge.PrintForm '打印收費票據
End If
End Sub
Private Sub cmdRefresh_Click()
If Check1.Value = 1 Then
Adodc1.Refresh '刷新記錄集
Else
cmbUser = "": cmbNumber = "" '清空輸入框
txtWater = "": txtPower = ""
txtGas = "": txtArea = ""
End If
'初始化收費票據
Label17 = "": Label18 = "": Label19 = "": Label20 = ""
Label21 = "": Label26 = "": Label22 = "": Label23 = ""
End Sub
Private Sub cmdSave_Click()
Dim isOk As Boolean
isOk = Trim(cmbUser) = "" Or Trim(cmbNumber) = "" Or Trim(txtWater) = "" _
Or Trim(txtPower) = "" Or Trim(txtGas) = "" Or Trim(txtArea) = "" _
Or Trim(txtDate) = ""
If Check1.Value = 0 Then
isOk = isOk Or Trim(txtWP) = "" Or Trim(txtPP) = "" Or Trim(txtGP) = "" _
Or Trim(txtAP) = ""
End If
If isOk Then '檢驗數據是否完整
MsgBox "收費記錄各個數據項不能為空白！", vbCritical, "物管收費"
Else
If Check1.Value = 0 Then '僅保存新增加的收費記錄
With Adodc1.Recordset
If CheckToPay Then '檢查是否應該繳費
.AddNew '保存新增收費記錄
.Fields("用戶名") = Trim(cmbUser)
.Fields("門牌號") = Trim(cmbNumber)
.Fields("水") = Val(txtWater) * Val(txtWP)
.Fields("電") = Val(txtPower) * Val(txtPP)
.Fields("氣") = Val(txtGas) * Val(txtGP)
.Fields("物管") = Val(txtArea) * Val(txtAP)
.Fields("日期") = Trim(txtDate)
.Update
MsgBox "收費記錄保存成功！", vbInformation, "物管收費"
End If
End With
End If
End If
DealError:
End Sub
Private Sub Form_Load()
Dim objCopy As New Recordset
Set objCopy.ActiveConnection = Adodc1.Recordset.ActiveConnection
With objCopy
.Open "Select 戶主,門牌號,面積 From 樓盤數據"
While Not .EOF
cmbUser.AddItem (.Fields("戶主"))
cmbUser.ItemData(cmbUser.NewIndex) = .Fields("面積")
cmbNumber.AddItem (.Fields("門牌號"))
.MoveNext
Wend
End With
cmbUser = "" '恢復添加收費數據默認狀態
cmbNumber = ""
txtWater = "": txtWP = "1.20": txtPower = "": txtPP = "0.50"
txtGas = "": txtGP = "1.00": txtArea = "": txtAP = "0.25"
txtDate = Format(Date, "Long date")
'初始化收費票據
Label17 = "": Label18 = "": Label19 = "": Label20 = ""
Label21 = "": Label26 = "": Label22 = "": Label23 = ""
End Sub
Private Sub cmdExit_Click()
Unload Me '關閉紅光苑物管收費窗體
End Sub
Private Function CheckToPay() As Boolean
With Adodc1.Recordset
If .RecordCount > 0 Then '檢查用戶是否應該繳費
.MoveFirst
.Find "門牌號='" & Trim(cmbNumber) & "'"
If Not .EOF Then
If DateDiff("d", Date, .Fields("日期")) > 30 Then
CheckToPay = True
Else
MsgBox "<" & cmbUser & ">上次繳費日期：" & .Fields("日期") _
& "，本月可不繳費！", vbInformation, "物管收費"
End If
End If
CheckToPay = True
Else
CheckToPay = True
End If
End With
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -