📄 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 + -