frmroomtransfer.frm

Call centeer gestion de usuarios todo ello gratis y bajo windows

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9360
      TabIndex        =   5
      Top             =   4320
      Width           =   1215
   End
   Begin VB.Label RTNo 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0FF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "rtno"
      BeginProperty Font 
         Name            =   "Century Gothic"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9360
      TabIndex        =   4
      Top             =   5280
      Width           =   1215
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0FF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   " transferred @ room "
      BeginProperty Font 
         Name            =   "Century Gothic"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9360
      TabIndex        =   3
      Top             =   2400
      Width           =   1215
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0FF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "room_no"
      BeginProperty Font 
         Name            =   "Century Gothic"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9360
      TabIndex        =   2
      Top             =   2880
      Width           =   1215
   End
   Begin VB.Label lblRoomNo 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0FF&
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "Century Gothic"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9360
      TabIndex        =   1
      Top             =   1440
      Width           =   1215
   End
   Begin VB.Label totalcharj 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0FF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "totalcharj"
      BeginProperty Font 
         Name            =   "Century Gothic"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9360
      TabIndex        =   0
      Top             =   3360
      Width           =   1215
   End
End
Attribute VB_Name = "frmRoomTransfer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim totcharj As Integer
Dim ar As Integer
Dim tp As Integer
Dim Change As Integer
Dim RonBerg As String
Public dept As String
Public o As Integer
Public c As Integer
Dim TransType As String
Dim Status As String
Dim StatusV As String

Private Sub cmbsearch_Click()
If cmbsearch.ListIndex = 0 Then
Combo1.Clear
lblroomno.Caption = ""
check_RS1
rs1.Open "select * from room_transaction", Cnn
While Not rs1.EOF
'If rs1.Fields(8) = False Then
Combo1.AddItem (rs1(2))
'End If
rs1.MoveNext
Wend
'=====
ElseIf cmbsearch.ListIndex = 1 Then
Combo1.Clear
lblroomno.Caption = ""
check_RS1
rs1.Open "select * from room_transaction", Cnn
While Not rs1.EOF
'If rs1.Fields(8) = False Then
Combo1.AddItem (rs1(3))
'End If
rs1.MoveNext
Wend
'=====
ElseIf cmbsearch.ListIndex = 2 Then
Combo1.Clear
lblroomno.Caption = ""
check_RS1
rs1.Open "select * from room_transaction", Cnn
While Not rs1.EOF
'If rs1.Fields(8) = False Then
Combo1.AddItem (rs1(0))
'End If
rs1.MoveNext
Wend
End If
End Sub

Private Sub Combo1_Click()
If cmbsearch.Text = "Guest ID" Then
check_RS
rs.Open "Select * from room_transaction where room_transaction.guest_id = " & Combo1, Cnn
RTNo.Caption = rs(0)
lblroomno.Caption = rs(3)
TransDate.Caption = rs(1)
lblGNo.Caption = rs(2)
fillt
'==========
ElseIf cmbsearch.Text = "Room No." Then
check_RS
rs.Open "Select * from room_transaction where room_transaction.room_no = " & Combo1, Cnn
RTNo.Caption = rs(0)
TransDate.Caption = rs(1)
lblGNo.Caption = rs(2)
lblroomno.Caption = rs(3)
fillt
'==========
ElseIf cmbsearch.Text = "Room Trans. No." Then
check_RS
rs.Open "Select * from room_transaction where room_transaction.room_trans_no = " & Combo1, Cnn
RTNo.Caption = rs(0)
TransDate.Caption = rs(1)
lblGNo.Caption = rs(2)
lblroomno.Caption = rs(3)
fillt
End If
End Sub
Public Sub fill()
Dim x As Integer
    lvroom.ListItems.Clear
While Not rs1.EOF
  Set lst = lvroom.ListItems.Add(, , rs1(0), , 1)
For x = 1 To 3
   lst.SubItems(x) = rs1(x)
Next x
rs1.MoveNext
Wend
End Sub

Private Sub Command1_Click()
check_RS
rs.Open "Select * from room_transaction " & Combo1, Cnn
fillt

End Sub

Private Sub Command2_Click()
Unload Me

End Sub

Private Sub Form_Load()
TransType = "Room"
Status = "OCCUPIED"
StatusV = "VACANT"
RonBerg = "Transfer"
check_RS
rs.Open "Select * from room_transaction " & Combo1, Cnn
fillt
'=====
check_RS1
rs1.Open "select * from room order by room_no asc", Cnn
fill
'========
c = 1
check_RS2
rs2.Open "select * from charges", Cnn
'=============
'fillr
While Not rs2.RecordCount = 0
 check_RS2
 c = c + 1
 rs2.Open "select * from charges where charge_no = " & c, Cnn
Wend
check_RS
rs.Open "select * from transaction_type", Cnn
While Not rs.EOF
If TransType = rs!Description Then
    Label12.Caption = rs!trans_code
    rs.MoveLast
    rs.MoveNext
Else
    rs.MoveNext
End If
Wend
Label7 = Date
dept = "Room Transaction"
End Sub




Private Sub lvroom_DblClick()
Dim i As Integer
i = 1
If lvroom.SelectedItem.ListSubItems(3) = "OCCUPIED" Then
MsgBox "Room already occupied...", vbInformation, "HMS"
Exit Sub
End If
If lblroomno = "" Then
   MsgBox "Please choose a Room", vbInformation, "HMS"
Exit Sub
End If
check_RS
rs.Open "select * from room", Cnn
While Not rs.EOF
If lvroom.SelectedItem.Text = rs!room_no Then
    Label4.Caption = rs!room_no
    rs.MoveLast
    rs.MoveNext
Else
    rs.MoveNext
End If
Wend
If RonBerg = "Transfer" Then
check_RS
rs.Open "select * from room_transaction where room_no = " & lblroomno, Cnn
tot.Caption = rs(5)
totcharj = rs(5) + totalpayable
totalcharj.Caption = totcharj
'================
check_RStemp
rstemp.Open "select * from room_transfer", Cnn
Cnn.Execute "INSERT INTO room_transfer (room_trans_no, room_trans_date, date_transfered, room_no, amount) VALUES (" & RTNo & ", '" & TransDate & _
"', '" & Label7 & "', '" & lblroomno & "', '" & totalpayable & "')"      '
'===============
Cnn.Execute "update room set status = '" & StatusV & "' where room_no = " & lblroomno
'===============
Cnn.Execute "update room_transaction set room_trans_date = '" & Label7 & "', total_charges = '" & totalcharj & "', room_no = '" & Label4 & "' where room_trans_no = " & RTNo
'===============
Cnn.Execute "update archive set room_no = '" & Label4 & "', checkin_date = '" & Label7 & "' where room_trans_no = " & RTNo
'===============
check_RS
rs.Open "select * from charges", Cnn
Cnn.Execute "INSERT INTO charges (charge_no, room_trans_no, trans_code, trans_no, amount, charge_date) VALUES (" & c & ", '" & RTNo & _
"', '" & Label12 & "', '" & RTNo & "', '" & totalpayable & "', '" & Date & "')"
'================
Cnn.Execute "update room set status = '" & Status & "' where room_no = " & Label4
MsgBox "Guest from Room " + lblroomno.Caption + Label6.Caption + Label4.Caption, vbInformation, "HMS"
Unload Me
End If
End Sub
Private Sub fillt()
On Error GoTo HELL
lvtran.ListItems.Clear
lvtran.Refresh
Dim i As Integer
i = 1
While Not rs.EOF
lvtran.Refresh
lvtran.ListItems.Add
lvtran.ListItems(i).Text = rs(0).Value '(, , 1)
lvtran.ListItems(i).SubItems(1) = rs(1).Value
lvtran.ListItems(i).SubItems(2) = rs(2).Value
lvtran.ListItems(i).SubItems(3) = rs(3).Value
'===========
check_RStemp
rstemp.Open "select rate from room where room_no = " & rs(3), Cnn
lvtran.ListItems(i).SubItems(4) = rstemp(0)
'===========
check_RStemp
lenght_of_stay = DateValue(Format(Now, "Short Date")) - rs(1).Value
   If lenght_of_stay = 0 Then
   lenght_of_stay = 1
   End If
lvtran.ListItems(i).SubItems(5) = lenght_of_stay
amount_payable = lenght_of_stay * lvtran.ListItems(i).SubItems(4)
'===========
lvtran.ListItems(i).SubItems(6) = rs(5).Value
total_payable = amount_payable + lvtran.ListItems(i).SubItems(6)
lvtran.ListItems(i).SubItems(7) = total_payable
RTNo.Caption = rs(0)
'GuestNo.Caption = rs(2)
'CheckinDate.Caption = rs(1)
'CheckoutDate.Caption = Date
totalpayable.Caption = total_payable
i = i + 1
rs.MoveNext
HELL:
Wend
End Sub