📄 frmreservation.frm
字号:
.strWhere = "{qry_rpt_Reservation.ReservationNo} = '" & txtReservationNo.Text & "'"
frmReports.Show vbModal
End With
End Sub
Private Sub Save_Record()
On Error GoTo err
Dim rsCustomers As New Recordset
Dim CustomerID As Integer
Dim CompanyID As Integer
If Trim(txtLastName.Text) = "" Or Trim(txtFirstName.Text) = "" Then
MsgBox "Please complete the name of a guest.", vbInformation
Exit Sub
End If
CN.BeginTrans
With rsCustomers
.Open "SELECT * FROM Customers WHERE LastName = '" & txtLastName.Text & "' AND FirstName = '" & txtFirstName.Text & "'", CN, adOpenStatic, adLockOptimistic
If .RecordCount > 0 Then
txtLastName.Tag = .Fields("CustomerID")
Else
.AddNew
CustomerID = getIndex("Customers")
txtLastName.Tag = CustomerID
.Fields("CustomerID") = CustomerID
.Fields("LastName") = txtLastName.Text
.Fields("FirstName") = txtFirstName.Text
.Update
End If
.Close
If txtCompany.Text = "" Then GoSub ContinueSave
.Open "SELECT * FROM Company WHERE Company = '" & txtCompany.Text & "'", CN, adOpenStatic, adLockOptimistic
If .RecordCount > 0 Then
txtCompany.Tag = .Fields("CompanyID")
Else
.AddNew
CompanyID = getIndex("Company")
txtCompany.Tag = CompanyID
.Fields("CompanyID") = CompanyID
.Fields("Company") = txtCompany.Text
.Update
End If
.Close
End With
ContinueSave:
If State = adStateAddMode Then
RS.AddNew
RS.Fields("ReservationNo") = txtReservationNo.Text
RS.Fields("ReservedBy") = CurrUser.USER_PK
RS.Fields("AddedByFK") = CurrUser.USER_PK
Else
RS.Fields("DateModified") = Now
RS.Fields("LastUserFK") = CurrUser.USER_PK
End If
With RS
.Fields("CustomerID") = txtLastName.Tag
.Fields("Address") = txtAddress.Text
.Fields("CountryID") = dcCountry.BoundText
.Fields("CompanyID") = IIf(txtCompany.Tag = "", Null, txtCompany.Tag)
.Fields("IDTypeID") = dcIDType.BoundText
.Fields("IDNumber") = txtIDNumber.Text
.Fields("RoomNumber") = dcRoomNumber.BoundText
.Fields("DateIn") = dtpDateIn.Value
.Fields("DateOut") = dtpDateOut.Value
.Fields("RateType") = dcRateType.BoundText
.Fields("Rate") = txtRate.Text
.Fields("OtherCharges") = txtOtherCharges.Text
.Fields("Discount") = txtDiscount.Text
.Fields("AmountPaid") = txtAmountPaid.Text
.Fields("Days") = txtDays.Text
.Fields("Adults") = txtAdults.Text
.Fields("Childrens") = txtChildrens.Text
.Fields("Total") = txtTotal.Text
.Fields("BusinessSourceID") = dcBusSource.BoundText
.Fields("VehicleID") = IIf(dcVehicle.BoundText = "", Null, dcVehicle.BoundText)
.Fields("VehicleModel") = txtVehicleModel.Text
.Fields("PlateNo") = txtPlateNo.Text
.Fields("Notes") = txtNotes.Text
.Update
End With
'----------------------------
'Delete record from Inventory and add a new check in/out date
CN.Execute "DELETE ID, Status " & _
"From [Inventory] " & _
"WHERE ID='" & txtReservationNo.Text & "' AND Status='Reservation'"
Dim dtpStartDate As Date
dtpStartDate = dtpDateIn.Value
Do Until dtpStartDate = dtpDateOut.Value
CN.Execute "INSERT INTO [Inventory] ( ID, RoomNumber, [Date], CustomerID, Status ) " & _
"VALUES ('" & txtReservationNo.Text & "', " & dcRoomNumber.BoundText & ", #" & dtpStartDate & "#, " & txtLastName.Tag & ", 'Reservation')"
dtpStartDate = dtpStartDate + 1
Loop
'----------------------------
CN.CommitTrans
HaveAction = True
Exit Sub
err:
CN.RollbackTrans
prompt_err err, Name, "cmdSave_Click"
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdSave_Click()
Call Save_Record
If State = adStateAddMode And HaveAction = True Then
MsgBox "New record has been successfully saved.", vbInformation
' Unload frmReservation
ElseIf State = adStateEditMode And HaveAction = True Then
MsgBox "Changes in record has been successfully saved.", vbInformation
' Unload frmReservation
End If
End Sub
Private Sub cmdUsrHistory_Click()
On Error Resume Next
Dim tDate1 As String
Dim tDate2 As String
Dim tUser1 As String
Dim tUser2 As String
tDate1 = Format$(RS.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
tDate2 = Format$(RS.Fields("DateModified"), "MMM-dd-yyyy HH:MM AMPM")
tUser1 = getValueAt("SELECT PK,CompleteName FROM Users WHERE PK = " & RS.Fields("AddedByFK"), "CompleteName")
tUser2 = getValueAt("SELECT PK,CompleteName FROM Users WHERE PK = " & RS.Fields("LastUserFK"), "CompleteName")
MsgBox "Date Added: " & tDate1 & vbCrLf & _
"Added By: " & tUser1 & vbCrLf & _
"" & vbCrLf & _
"Last Modified: " & tDate2 & vbCrLf & _
"Modified By: " & tUser2, vbInformation, "Modification History"
tDate1 = vbNullString
tDate2 = vbNullString
tUser1 = vbNullString
tUser2 = vbNullString
End Sub
Private Sub dcRateType_Click(Area As Integer)
On Error GoTo err
Dim rsRoomRates As New ADODB.Recordset
With rsRoomRates
.Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & dcRoomNumber.BoundText & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
If .RecordCount > 0 Then
txtRate.Text = toMoney(!RoomRate)
txtAdults.Text = !NoofPerson
hsAdults.Min = !NoofPerson
hsAdults.Value = !NoofPerson
txtAdults.Tag = !ExtraAdultRate
txtChildrens.Tag = !ExtraChildRate
End If
End With
rsRoomRates.Close
Call ComputeRate
Exit Sub
err:
CN.RollbackTrans
prompt_err err, Name, "dcRateType_Click"
Screen.MousePointer = vbDefault
End Sub
Private Sub dcRoomNumber_Click(Area As Integer)
dcRateType_Click 0
End Sub
Public Sub dtpDateOut_Change()
If dtpDateOut.Value < dtpDateIn.Value Then Exit Sub
txtDays.Text = dtpDateOut.Value - dtpDateIn.Value
hsDays.Value = txtDays.Text
Call ComputeRate
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Form_Load()
On Error GoTo err
RS.CursorLocation = adUseClient
bind_dc "SELECT * FROM qry_Available_Rooms", "AvailableRoom", dcRoomNumber, "RoomNumber", True
bind_dc "SELECT * FROM Countries", "Country", dcCountry, "CountryID", True
bind_dc "SELECT * FROM [ID Type]", "IDType", dcIDType, "IDTypeID", True
bind_dc "SELECT * FROM [Rate Type]", "RateType", dcRateType, "RateTypeID", True
bind_dc "SELECT * FROM [Business Source]", "BusinessSource", dcBusSource, "BusinessSourceID", True
bind_dc "SELECT * FROM [Vehicles]", "Vehicle", dcVehicle, "VehicleID", False
dcCountry.Text = "Philippines"
Dim rsRoomRates As New ADODB.Recordset
'Check the form state
If State = adStateAddMode Then
RS.Open "SELECT * FROM Reservation WHERE ReservationNo = '" & PK & "'", CN, adOpenStatic, adLockOptimistic
cmdUsrHistory.Enabled = False
dtpDateIn.Value = Date
dtpDateOut.Value = dtpDateIn.Value + 1
GeneratePK
rsRoomRates.Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & dcRoomNumber.BoundText & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
With rsRoomRates
If .RecordCount > 0 Then
txtRate.Text = toMoney(!RoomRate)
txtAdults.Text = !NoofPerson
hsAdults.Min = !NoofPerson
hsAdults.Value = !NoofPerson
txtAdults.Tag = !ExtraAdultRate
txtChildrens.Tag = !ExtraChildRate
End If
End With
dcBusSource.BoundText = 2
' Call txtDays_Change
Call ComputeRate
Else
RS.Open "SELECT * FROM Reservation WHERE ReservationNo = '" & PK & "'", CN, adOpenStatic, adLockOptimistic
rsRoomRates.Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & RightSplitUF(dcRoomNumber.Tag) & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
With rsRoomRates
If .RecordCount > 0 Then
txtRate.Text = toMoney(!RoomRate)
hsAdults.Min = !NoofPerson
txtAdults.Tag = !ExtraAdultRate
txtChildrens.Tag = !ExtraChildRate
End If
End With
DisplayForEditing
CmdCheckIn.Visible = True
CmdPrint.Visible = True
CmdCancel.Visible = True
Call ComputeRate
End If
rsRoomRates.Close
Exit Sub
err:
prompt_err err, Name, "Form_Load"
Screen.MousePointer = vbDefault
End Sub
'Procedure used to generate PK
Private Sub GeneratePK()
PK = getIndex("Reservation")
txtReservationNo.Text = GenerateID(PK, Format$(Date, "yy") & "-", "00000")
End Sub
Private Sub Form_Unload(Cancel As Integer)
If HaveAction = True And Shortcut = False Then
frmReservationList.RefreshRecords
End If
Set frmReservation = Nothing
End Sub
Private Sub hsAdults_Change()
txtAdults.Text = hsAdults.Value
' Call ComputeAdultsRate
Call ComputeRate
End Sub
Private Sub hsChildrens_Change()
txtChildrens.Text = hsChildrens.Value
' Call ComputeChildrensRate
Call ComputeRate
End Sub
Private Sub hsDays_Change()
dtpDateOut.Value = dtpDateIn.Value + hsDays.Value
txtDays.Text = hsDays.Value
Call ComputeRate
End Sub
Private Sub ComputeRate()
If txtAdults.Tag = "" Then Exit Sub
Dim intAdults As Integer
If txtAdults.Text = hsAdults.Min Then
intAdults = 0
Else
intAdults = CInt(txtAdults.Text) - hsAdults.Min
End If
txtTotalCharges.Text = (toMoney(txtRate.Text) * toNumber(txtDays.Text)) + (toMoney(txtAdults.Tag) * intAdults) + (toMoney(txtChildrens.Tag) * toNumber(txtChildrens.Text))
txtTotalCharges.Text = toMoney(txtTotalCharges.Text)
txtSubTotal.Text = toMoney(toNumber(txtTotalCharges.Text) + toNumber(txtOtherCharges.Text))
txtTotal.Text = toMoney(toNumber(txtSubTotal.Text) - (toNumber(txtSubTotal.Text) * toNumber(txtDiscount.Text) / 100))
txtBalance.Text = toMoney(toNumber(txtTotal.Text) - toNumber(txtAmountPaid.Text))
End Sub
Private Sub txtAmountPaid_Change()
txtBalance.Text = toMoney(toNumber(txtTotal.Text) - toNumber(txtAmountPaid.Text))
End Sub
Private Sub txtDiscount_Change()
Call ComputeRate
End Sub
Private Sub txtDiscount_GotFocus()
HLText txtDiscount
End Sub
Private Sub txtDiscount_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtDiscount_Validate(Cancel As Boolean)
txtDiscount.Text = toMoney(txtDiscount.Text)
End Sub
Private Sub txtRate_GotFocus()
HLText txtRate
End Sub
Private Sub txtRate_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtRate_Validate(Cancel As Boolean)
txtRate.Text = toMoney(txtRate.Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -