?? frmpayyajin.frm
字號:
Height = 975
Index = 6
Left = 1320
MultiLine = -1 'True
TabIndex = 12
Top = 1560
Width = 6495
End
Begin VB.TextBox Text1
Height = 375
Index = 5
Left = 6720
TabIndex = 11
Top = 960
Width = 1095
End
Begin VB.TextBox Text1
Height = 375
Index = 4
Left = 3960
TabIndex = 10
Top = 960
Width = 1095
End
Begin VB.TextBox Text1
Height = 375
Index = 3
Left = 1320
TabIndex = 9
Top = 960
Width = 1095
End
Begin VB.TextBox Text1
Height = 375
Index = 2
Left = 6720
TabIndex = 8
Top = 360
Width = 1095
End
Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 3960
TabIndex = 7
Top = 360
Width = 1095
End
Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 1320
TabIndex = 6
Top = 360
Width = 1095
End
Begin VB.Label Label1
Caption = " 備 注"
Height = 255
Index = 6
Left = 360
TabIndex = 20
Top = 1920
Width = 855
End
Begin VB.Label Label2
Caption = "元"
Height = 255
Index = 0
Left = 5160
TabIndex = 19
Top = 480
Width = 255
End
Begin VB.Label Label1
Caption = "收費日期"
Height = 255
Index = 5
Left = 5760
TabIndex = 18
Top = 480
Width = 855
End
Begin VB.Label Label1
Caption = "押金金額"
Height = 255
Index = 4
Left = 2880
TabIndex = 17
Top = 480
Width = 855
End
Begin VB.Label Label1
Caption = "房屋編號"
Height = 255
Index = 3
Left = 5760
TabIndex = 16
Top = 1080
Width = 855
End
Begin VB.Label Label1
Caption = "客戶姓名"
Height = 255
Index = 2
Left = 2880
TabIndex = 15
Top = 1080
Width = 855
End
Begin VB.Label Label1
Caption = "合同編號"
Height = 255
Index = 1
Left = 360
TabIndex = 14
Top = 1080
Width = 855
End
Begin VB.Label Label1
Caption = " 收費編號"
Height = 255
Index = 0
Left = 240
TabIndex = 13
Top = 480
Width = 855
End
End
End
End
Attribute VB_Name = "frmPayYaJin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sqlpay As String
Dim sqlcon As String
Dim sqlch As String
Dim rs_pay As New ADODB.Recordset
Dim rs_con As New ADODB.Recordset
Dim rs_ch As New ADODB.Recordset
Private Sub cmdAdd_Click()
'先檢測數據完整性
If Text1(0).Text = "" Then
MsgBox "收費編號不可為空！", vbOKOnly + vbInformation, "注意"
Text1(0).SetFocus
Exit Sub
End If
If Text1(2).Text = "" Or IsDate(Text1(2).Text) = False Then
MsgBox "收費日期應為這樣的日期格式：2003-8-3！", vbOKOnly + vbInformation, "注意"
Text1(2).SetFocus
Exit Sub
End If
If Text1(3).Text = "" Then
MsgBox "合同編號不可為空！", vbOKOnly + vbInformation, "注意"
Text1(3).SetFocus
Exit Sub
End If
'檢測該收費編號是否已存在
sqlch = "select * from YaJIn where 收費編號 = '" & Text1(0).Text & "'"
rs_ch.Open sqlch, conn, adOpenStatic, adLockOptimistic
If rs_ch.EOF = False Then
MsgBox "該收費編號已經存在，請重新輸入一個！", vbOKOnly + vbInformation, "注意"
Text1(0).SetFocus
rs_ch.Close
Exit Sub
End If
rs_ch.Close
'還需要檢測合同編號是否存在、并且自動寫入客戶姓名和房屋編號以及押金
sqlcon = "select * from Contract where 合同編號 = '" & Text1(3).Text & "'"
rs_con.Open sqlcon, conn, adOpenStatic, adLockOptimistic
If rs_con.EOF = True Then
MsgBox "該合同編號不存在！", vbOKOnly + vbInformation, "注意"
rs_con.Close
Text1(3).SetFocus
Exit Sub
Else
Text1(1).Text = rs_con.Fields(8)
Text1(4).Text = rs_con.Fields(1)
Text1(5).Text = rs_con.Fields(2)
End If
rs_con.Close
'加入押金收費表
sqlpay = "select * from YaJIn "
rs_pay.Open sqlpay, conn, adOpenStatic, adLockOptimistic
rs_pay.AddNew
For i = 0 To 6
rs_pay.Fields(i) = Text1(i)
Next i
rs_pay.Update
rs_pay.Close
MsgBox "收取押金成功！", vbOKOnly + vbInformation, "注意"
'添加完后，需要設置收取押金按鈕不可用
cmdAdd.Enabled = False
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdReset_Click()
'清空所有text
For i = 0 To 6
Text1(i).Text = ""
Next i
'設定收費日期為當前日期
Text1(2).Text = Date
'設置收取押金按鈕為可用
cmdAdd.Enabled = True
End Sub
Private Sub Form_Load()
Dim X0 As Long
Dim Y0 As Long
'讓窗體居中
X0 = Screen.Width
Y0 = Screen.Height
X0 = (X0 - Me.Width) / 2
Y0 = (Y0 - Me.Height) / 2
Me.Move X0, Y0
'押金金額、客戶姓名和房屋編號應根據合同編號自動填入，因此需要設定它們不可寫
Text1(1).Enabled = False
Text1(4).Enabled = False
Text1(5).Enabled = False
'設置所有合同資料選項卡的text為不可寫
For i = 7 To 18
Text1(i).Enabled = False
Next i
'判斷是從frmSignContract調用的還是菜單直接調用的本窗體
If fromContract = False Then
'菜單直接調用的
'如果要顯示的是押金收取選項卡
If SSTab1.Tab = 0 Then
'清空所有text
For i = 0 To 6
Text1(i).Text = ""
Next i
'設定收費日期為當前日期
Text1(2).Text = Date
'如果要顯示的是合同資料選項卡
ElseIf SSTab1.Tab = 1 Then
'開始時，由于押金收取信息沒有顯示，因此相應的合同資料也都顯示為空
For i = 7 To 18
Text1(i).Text = ""
Next i
cmdAdd.Enabled = False
cmdReset.Enabled = False
End If
ElseIf fromContract = True Then
'從frmSignContract窗體調用的
If SSTab1.Tab = 0 Then
Text1(1).Text = frmSignContract.Text1(8).Text
Text1(2).Text = Date
Text1(3).Text = frmSignContract.Text1(0).Text
Text1(4).Text = frmSignContract.Text1(1).Text
Text1(5).Text = frmSignContract.Text1(2).Text
ElseIf SSTab1.Tab = 1 Then
For i = 0 To 11
Text1(i + 7).Text = frmSignContract.Text1(i).Text
Next i
cmdAdd.Enabled = False
cmdReset.Enabled = False
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'設置fromContract=false
fromContract = False
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
If SSTab1.Tab = 0 Then
'不需要改變數據，只需要相應修改按鈕是否可用
cmdReset.Enabled = True
cmdAdd.Enabled = True
'設定收費日期為當前日期
Text1(2).Text = Date
'合同選項卡
Else
cmdReset.Enabled = False
cmdAdd.Enabled = False
'如果押金收取選項卡中合同編號為空
If Text1(3).Text = "" Then
For i = 7 To 18
Text1(i).Text = ""
Next i
'如果押金收取選項卡中合同編號不為空，則打開相應記錄
Else
sqlcon = "select * from Contract where 合同編號 = '" & Text1(3).Text & "'"
rs_con.Open sqlcon, conn, adOpenStatic, adLockOptimistic
If rs_con.EOF = True Then
MsgBox "相應合同編號的記錄不存在！", vbOKOnly + vbInformation, "注意"
rs_con.Close
For i = 7 To 18
Text1(i).Text = ""
Next i
Exit Sub
Else
For i = 7 To 18
Text1(i).Text = rs_con.Fields(i - 7)
Next i
rs_con.Close
End If
End If
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -