?? frmxuqian.frm
字號:
Height = 615
Index = 11
Left = 1200
MultiLine = -1 'True
TabIndex = 5
Top = 2640
Width = 6135
End
Begin VB.Label Label2
Caption = "月"
Height = 255
Index = 6
Left = 7440
TabIndex = 32
Top = 960
Width = 255
End
Begin VB.Label Label1
Caption = "新合同編號"
Height = 255
Index = 0
Left = 120
TabIndex = 31
Top = 360
Width = 975
End
Begin VB.Label Label1
Caption = "客戶姓名"
Height = 255
Index = 1
Left = 2760
TabIndex = 30
Top = 360
Width = 735
End
Begin VB.Label Label1
Caption = "房屋編號"
Height = 255
Index = 2
Left = 5280
TabIndex = 29
Top = 360
Width = 735
End
Begin VB.Label Label1
Caption = "起租日期"
Height = 255
Index = 3
Left = 360
TabIndex = 28
Top = 960
Width = 735
End
Begin VB.Label Label1
Caption = "止租日期"
Height = 255
Index = 4
Left = 2760
TabIndex = 27
Top = 960
Width = 735
End
Begin VB.Label Label1
Caption = "租 期"
Height = 255
Index = 5
Left = 5280
TabIndex = 26
Top = 960
Width = 735
End
Begin VB.Label Label1
Caption = "月租金"
Height = 255
Index = 6
Left = 360
TabIndex = 25
Top = 1560
Width = 735
End
Begin VB.Label Label1
Caption = "總租金"
Height = 255
Index = 7
Left = 2880
TabIndex = 24
Top = 1560
Width = 615
End
Begin VB.Label Label1
Caption = "押金"
Height = 255
Index = 8
Left = 5400
TabIndex = 23
Top = 1560
Width = 495
End
Begin VB.Label Label2
Caption = "元"
Height = 255
Index = 0
Left = 2520
TabIndex = 22
Top = 1560
Width = 255
End
Begin VB.Label Label2
Caption = "元"
Height = 255
Index = 1
Left = 4920
TabIndex = 21
Top = 1560
Width = 255
End
Begin VB.Label Label2
Caption = "元"
Height = 255
Index = 2
Left = 7440
TabIndex = 20
Top = 1560
Width = 255
End
Begin VB.Label Label1
Caption = "業務員"
Height = 255
Index = 9
Left = 360
TabIndex = 19
Top = 2160
Width = 735
End
Begin VB.Label Label1
Caption = "續簽日期"
Height = 255
Index = 10
Left = 2760
TabIndex = 18
Top = 2160
Width = 735
End
Begin VB.Label Label1
Caption = "備 注"
Height = 255
Index = 14
Left = 360
TabIndex = 17
Top = 2880
Width = 735
End
End
End
Begin VB.Frame Frame3
Caption = "功能鍵"
Height = 975
Left = 1680
TabIndex = 0
Top = 240
Width = 4695
Begin VB.CommandButton cmdSign
Caption = "續 簽"
Height = 495
Left = 840
TabIndex = 2
Top = 240
Width = 975
End
Begin VB.CommandButton cmdClose
Caption = "關 閉"
Height = 495
Left = 2640
TabIndex = 1
Top = 240
Width = 975
End
End
End
Attribute VB_Name = "frmXuQian"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs_con As New ADODB.Recordset
Dim rs_xucon As New ADODB.Recordset
Dim rs_oldcon As New ADODB.Recordset
Dim rs_cxcon As New ADODB.Recordset '用于檢查新合同編號是否已存在
Dim sqlcon As String
Dim sqlxucon As String
Dim sqloldcon As String
Dim sqlcxcon As String
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdSign_Click()
'先檢查輸入數據完整性
For i = 0 To 2
If Text1(i).Text = "" Then
MsgBox "除備注外的所有項不可為空！", vbOKOnly + vbInformation, "注意"
Text1(i).SetFocus
Exit Sub
End If
Next i
For i = 3 To 4
If Text1(i).Text = "" Or IsDate(Text1(i).Text) = False Then
MsgBox "日期應為這樣的格式：2003-7-15！", vbOKOnly + vbInformation, "注意"
Text1(i).SetFocus
Exit Sub
End If
Next i
If Text1(6).Text = "" Or IsNumeric(Text1(6).Text) = False Then
MsgBox "月租金應為數字！", vbOKOnly + vbInformation, "注意"
Text1(6).SetFocus
Exit Sub
End If
If Text1(8).Text = "" Or IsNumeric(Text1(8).Text) = False Then
MsgBox "押金應為數字！", vbOKOnly + vbInformation, "注意"
Text1(8).SetFocus
Exit Sub
End If
If Text1(9).Text = "" Then
MsgBox "業務員不可為空！", vbOKOnly + vbInformation, "注意"
Text1(9).SetFocus
Exit Sub
End If
If Text1(10).Text = "" Or IsDate(Text1(10).Text) = False Then
MsgBox "簽訂日期應為這樣的格式：2003-7-15！", vbOKOnly + vbInformation, "注意"
Text1(10).SetFocus
Exit Sub
End If
'止租日期不能前于起租日期
If DateValue(Text1(4).Text) < DateValue(Text1(3).Text) Then
MsgBox "止租日期不能前于起租日期", vbOKOnly + vbInformation, "注意"
Text1(4).SetFocus
Exit Sub
End If
'租期等于起租日期和止租日期之差，結尾不足一月，按一月計。
'使用datediff 函數計算日期之差
Text1(5).Text = Int(DateDiff("d", DateValue(Text1(3).Text), DateValue(Text1(4).Text)) / 31) + 1
'總租金等于月租金乘以租期
Text1(7).Text = Val(Text1(5).Text) * Val(Text1(6).Text)
'需要檢查新合同編號是否已存在
If rs_cxcon.State = adStateOpen Then
rs_cxcon.Close
End If
sqlcxcon = "select * from Contract where 合同編號 = '" & Text1(0).Text & "'"
rs_cxcon.Open sqlcxcon, conn, adOpenStatic, adLockOptimistic
If rs_cxcon.EOF = False Then
MsgBox "輸入的新合同編號已經存在，請另選擇一個！", vbOKOnly + vbInformation, "注意"
Text1(0).SetFocus
rs_cxcon.Close
Exit Sub
End If
'續簽需要把新續簽合同加入合同表，
If rs_xucon.State = adStateOpen Then
rs_xucon.Close
End If
sqlxucon = "select * from Contract"
rs_xucon.Open sqlxucon, conn, adOpenStatic, adLockOptimistic
rs_xucon.AddNew
For i = 0 To 11
rs_xucon.Fields(i) = Text1(i).Text
Next i
rs_xucon.Update
'需要把原合同加入歷史合同表中
If rs_oldcon.State = adStateOpen Then
rs_oldcon.Close
End If
sqloldcon = "select * from OldContract"
rs_oldcon.Open sqloldcon, conn, adOpenStatic, adLockOptimistic
rs_oldcon.AddNew
For i = 0 To 11
rs_oldcon.Fields(i) = rs_con.Fields(i)
Next i
rs_oldcon.Update
'需要從合同表中刪除原合同
rs_con.Delete
rs_con.Update
'提示用于續簽成功
MsgBox "續簽成功！", vbOKOnly + vbInformation, "注意"
'設置所有text不可寫
For i = 0 To 11
Text1(i).Enabled = False
Next i
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
'需要設定原合同所有text框不可寫
For i = 12 To 23
Text1(i).Enabled = False
Next i
'因為是續簽，續簽合同的客戶姓名和房屋編號不可改
Text1(1).Enabled = False
Text1(2).Enabled = False
'新合同租期和總租金由計算而得，不可寫
Text1(5).Enabled = False
Text1(7).Enabled = False
'設定一個變量用于存儲frmXuQianNo窗體所輸入的需要續簽的合同的編號
Dim conNo As String
conNo = frmXuQianNo.Text1.Text
'需要打開原合同記錄
If rs_con.State = adStateOpen Then
rs_con.Close
End If
sqlcon = "select * from Contract where 合同編號 = '" & conNo & "'"
rs_con.Open sqlcon, conn, adOpenStatic, adLockOptimistic
'如果輸入的合同編號不存在，退出，要求重新輸入
If rs_con.EOF = True Then
MsgBox "輸入的合同編號不存在！", vbOKOnly + vbInformation, "注意"
'調用frmXuQianNo窗體，重新輸入合同編號
frmXuQianNo.Show
rs_con.Close
Exit Sub
End If
'在新合同中顯示與原合同相同的客戶姓名，房屋編號，租金,押金等數據
Text1(1).Text = rs_con.Fields(1)
Text1(2).Text = rs_con.Fields(2)
Text1(6).Text = rs_con.Fields(6)
Text1(8).Text = rs_con.Fields(8)
'設置當前日期為起租日期和續簽日期
Text1(3).Text = Date
Text1(10).Text = Date
'在原合同選項卡中顯示原合同
For i = 0 To 11
Text1(i + 12).Text = rs_con.Fields(i)
Next i
'根據選項卡不同，分別處理
If SSTab1.Tab = 0 Then
'新續簽合同選項卡
'設置續簽按鈕可用
cmdSign.Enabled = True
ElseIf SSTab1.Tab = 1 Then
'原合同選項卡
'設置續簽按鈕不可用
cmdSign.Enabled = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If rs_con.State = adStateOpen Then
rs_con.Close
End If
If rs_xucon.State = adStateOpen Then
rs_xucon.Close
End If
If rs_cxcon.State = adStateOpen Then
rs_cxcon.Close
End If
If rs_oldcon.State = adStateOpen Then
rs_oldcon.Close
End If
Unload Me
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
If SSTab1.Tab = 0 Then
'設置續簽按鈕可用
cmdSign.Enabled = True
ElseIf SSTab1.Tab = 1 Then
'設置續簽按鈕不可用
cmdSign.Enabled = False
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -