Banner

Sunday, April 26, 2020

Create Rent A Car Agreement Form Excel VBA

Create Rent A Car Agreement Form Excel VBA

Welcome razakmcr Excel Tutorial 
In this Tutorial I Created Rent A car Agreement form 
 Name Address Contact And departure date arrival date and count day and extra hours rent amount   And Grand Total  Automatically  
I thing this will useful information  if Any wrong Any doubt please  Inform me 
Thank you   Also Watch Video Below And VBA Code
आपका स्वागत है razakmcr एक्सेल ट्यूटोरियल
इस ट्यूटोरियल में मैंने रेंट ए कार एग्रीमेंट फॉर्म तैयकिया नाम पता संपर्क और प्रस्थान की तारीख आगमन कतऔरदिन और अतिरिक्त घंटे किराया राशि और ग्रैंड कुल स्वचालित रूप से गिनें
मुझे लगता है कि यह उपयोगी जानकारी होगी यदि कोई भी गलत हो तो कृपया मुझे सूचित करें

धन्यवाद इसके अलावा नीचे वीडियो देखें और VBA कोड

Create Rent A Car Agreement Form Excel VBA

Watch Video



Check VBA Code

This Code For Ageement Number Project And Departure Date  Departure Time Arrival Date And Time


Private Sub UserForm_Initialize()
Dim RNG As Long
RNG = Sheet4.Range("A1000000").End(xlUp).Row + 1
Me.AGR1 = RNG + 11000
Me.Date1 = Date 'Dedparture Date
Me.Time1 = Format(Time, "HH:MM AM/PM") 'Departure Time
Me.Date2 = Date 'Arrival Date
Me.Time2 = Format(Time, "HH:MM AM/PM") 'Arrival Time
End Sub
This Code For Textbox Textformat To properCase
Private Sub TB4_Change()
On Error Resume Next      'Textbox ProperCase
Me.TB4 = Format(StrConv(Me.TB4, vbProperCase))
End Sub
Private Sub TB5_Change()
On Error Resume Next     'Textbox ProperCase
Me.TB5 = Format(StrConv(Me.TB5, vbUpperCase))
End Sub
Private Sub TB8_Change()
On Error Resume Next      'Textbox ProperCase
Me.TB8 = Format(StrConv(Me.TB8, vbProperCase))
End Sub

This Code For (CommandButtton) Frame Enable for Cteate agreement  Fill combobox 
Private Sub DeptCMD_Click() 'Commandbutton
Dim i As Long
'For Departure
Me.DeptFrame.Enabled = True
Me.ComboBox1.Clear
For i = 2 To Sheet2.Range("A100000").End(xlUp).Row
Me.ComboBox1.AddItem Sheet2.Cells(i, "A") 'Fill Vehicle Number
Me.ComboBox1.List(Me.ComboBox1.ListCount - 1, 1) = Sheet2.Cells(i, "B") 'Vehicle Name
Next i
Me.TB1.SetFocus
End Sub

This Code For (CommandButtton) Frame Enable for Cteate agreement  Fill combobox 
Private Sub ArrCMD_Click() 'Commandbutton
On Error Resume Next
Me.ArrFrame.Enabled = True
Me.ArrDate = Date
Me.ARRTime = Format(Time, "HH:MM AM/PM")
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate) 'In Date-Out Date
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'Intime - Out Time
Dim RNG1 As Long, i As Long
'Search Data to Arrival Form Matching By Agreement Number
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
For i = 2 To RNG1        '(Agreement No)
If Sheet4.Cells(i, "D") = Val(Me.AGR2) Then
With Sheet4
Me.AGR1.Value = .Range("D" & i)              'Sheet4Column(D)
Me.TB1 = .Range("E" & i)                       'Renter Name
Me.TB2 = .Range("F" & i)                       'Cntact
Me.IDBox = .Range("G" & i)                    'Idbox
Me.TB3 = .Range("H" & i)                       'PP No
Me.TB4 = .Range("i" & i)                       'Driver Name
Me.TB5 = .Range("j" & i)                        'Nationality
Me.TB6 = .Range("K" & i)                       'Contact
Me.TB7 = .Range("L" & i)                      'Driving License No
Me.TB8 = .Range("M" & i)                      'Place If Issue
Me.TB9 = .Range("N" & i)                        'Expiry date
Me.ComboBox1 = .Range("O" & i)                 'Expiry date
Me.TB12 = .Range("P" & i)                      'Vehicle Name
Me.DPTDate = .Range("Q" & i)
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate)    'Calculate Days
Me.DPTTime = Format(.Range("R" & i), "HH:MM AM/PM") 'Time
Me.Date1 = .Range("Q" & i)
Me.Time1 = Format(.Range("R" & i), "HH:MM AM/PM")
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'calculate Time
Me.TB14 = .Range("V" & i)                      'Rent per Day
Me.TB17 = .Range("X" & i)                      'Extran Charge
Me.TB18 = .Range("Y" & i)                      'Traffic fine
Me.TB19 = .Range("Z" & i)                      'parking fine
Me.TB11 = .Range("V" & i)                      'Rent per Day
Me.TB21 = .Range("AC" & i).Value
Me.TB23 = .Range("AE" & i)                     'Status
End With
End If
Next i
Call TB13_Change
End Sub
This Code For Textbox Format
Private Sub ArrDate_AfterUpdate()
On Error Resume Next
Me.ArrDate = CDate(Me.ArrDate)
End Sub
Private Sub ComboBox1_Click()
Me.TB12 = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1) 'Vehicle Name
End Sub
This Code For (CommandButtton) Frame Enable And Arrival vehicle Checkout

Private Sub ArrCMD_Click() 'Commandbutton
On Error Resume Next
Me.ArrFrame.Enabled = True
Me.ArrDate = Date
Me.ARRTime = Format(Time, "HH:MM AM/PM")
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate) 'In Date-Out Date
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'Intime - Out Time
Dim RNG1 As Long, i As Long
'Search Data to Arrival Form Matching By Agreement Number
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
For i = 2 To RNG1        '(Agreement No)
If Sheet4.Cells(i, "D") = Val(Me.AGR2) Then
With Sheet4
Me.AGR1.Value = .Range("D" & i)              'Sheet4Column(D)
Me.TB1 = .Range("E" & i)                       'Renter Name
Me.TB2 = .Range("F" & i)                       'Cntact
Me.IDBox = .Range("G" & i)                    'Idbox
Me.TB3 = .Range("H" & i)                       'PP No
Me.TB4 = .Range("i" & i)                       'Driver Name
Me.TB5 = .Range("j" & i)                        'Nationality
Me.TB6 = .Range("K" & i)                       'Contact
Me.TB7 = .Range("L" & i)                      'Driving License No
Me.TB8 = .Range("M" & i)                      'Place If Issue
Me.TB9 = .Range("N" & i)                        'Expiry date
Me.ComboBox1 = .Range("O" & i)                 'Expiry date
Me.TB12 = .Range("P" & i)                      'Vehicle Name
Me.DPTDate = .Range("Q" & i)
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate)    'Calculate Days
Me.DPTTime = Format(.Range("R" & i), "HH:MM AM/PM") 'Time
Me.Date1 = .Range("Q" & i)
Me.Time1 = Format(.Range("R" & i), "HH:MM AM/PM")
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'calculate Time
Me.TB14 = .Range("V" & i)                      'Rent per Day
Me.TB17 = .Range("X" & i)                      'Extran Charge
Me.TB18 = .Range("Y" & i)                      'Traffic fine
Me.TB19 = .Range("Z" & i)                      'parking fine
Me.TB11 = .Range("V" & i)                      'Rent per Day
Me.TB21 = .Range("AC" & i).Value
Me.TB23 = .Range("AE" & i)                     'Status
End With
End If
Next i
Call TB13_Change
End Sub
Private Sub ArrDate_AfterUpdate()
On Error Resume Next
Me.ArrDate = CDate(Me.ArrDate)
End Sub
Private Sub ComboBox1_Click()
Me.TB12 = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1) 'Vehicle Name
End Sub

This Code For CommandButtton Ebable And Desable And Statusbar(Textbox) Text project
Private Sub TB23_Change()
On Error Resume Next
If Me.TB23 = "Arrived" Then
Me.TB23.ForeColor = &H8000&      'Stauts Bar Display On Departure Or Arrived
Me.CommandButton4.Enabled = False
Else
Me.TB23.ForeColor = vbRed
Me.CommandButton4.Enabled = True
End If
On Error Resume Next
If Val(Me.TB22) >= 1 Then
Me.CommandButton4.Enabled = True
Me.TB22.ForeColor = vbRed  'Balance Amount
End If
End Sub

This Code For Textbox Format And  Divide And Sum And Multiple Amount
Private Sub TB1_Change()
On Error Resume Next
Me.TB1 = Format(StrConv(Me.TB1, vbProperCase))
End Sub
Private Sub TB10_Change()
On Error Resume Next
Me.TB10 = Format(StrConv(Me.TB1, vbProperCase))
End Sub
Private Sub TB13_Change()
On Error Resume Next
Me.TB15 = Format(Val(Me.TB13) * Val(Me.TB14), "#####.00")
Call TB16_Change
Call TB15_Change
End Sub
Private Sub TB14_Change()
On Error Resume Next
Call TB13_Change
End Sub
Private Sub TB15_Change()
On Error Resume Next
'Rent Calculater(rent Amount) +(ExtraCharge) +(Trafiic fine)+(Parking fine)
Me.TB20 = Format(Val(Me.TB15) + Val(Me.TB17) + Val(Me.TB18) + Val(Me.TB19), "#####.00")
Call TB21_Change
End Sub
Private Sub TB16_Change()
On Error Resume Next
A = Val(Me.TB14) / 24  'RentAmount/24 hour
Me.TB17 = Format(Val(Me.TB16) * A, "#####.00") 'Amount* hours
Call TB15_Change
End Sub

This Code For Textbox Format And Call Micro
Private Sub TB17_Change()
On Error Resume Next
Call TB15_Change
End Sub
Private Sub TB18_AfterUpdate()
On Error Resume Next
Me.TB18 = Format(Me.TB18, "#####.00") 'Number format
End Sub
Private Sub TB18_Change()
Call TB15_Change
End Sub
Private Sub TB19_AfterUpdate()
On Error Resume Next
Me.TB19 = Format(Me.TB19, "#####.00") 'Number format
End Sub
Private Sub TB19_Change()
Call TB15_Change
End Sub
Private Sub TB21_Change()
On Error Resume Next
                '(Pay Amount) - (Paid Amount)
Me.TB22 = Format(Val(Me.TB20) - Val(Me.TB21), "#####.00") 'Number format
Private Sub TB1_Change()
This Code For Option Button Choose Pass/Id/Other
Private Sub OptionButton1_Click()
Me.IDBox = "Passport"
Me.TBRange.Value = "C"
Me.TB3.SetFocus
End Sub
Private Sub OptionButton2_Click()
Me.IDBox = "ID Card"
Me.TBRange = "D"
Me.TB3.SetFocus
End Sub
Private Sub OptionButton3_Click()
Me.IDBox = "Other"
Me.TBRange = "E"
Me.TB3.SetFocus
End Sub
This Code For Textbox If function For Sheet4(Databse) Column Address C D E
Private Sub DPTDate_AfterUpdate()
On Error Resume Next
Me.DPTDate = CDate(Me.DPTDate)
End Sub
Private Sub IDBox_Change()
If Me.IDBox = "Passport" Then
Me.TBRange = "C"
ElseIf Me.IDBox = "ID Card" Then
Me.TBRange = "D"
Else
Me.TBRange = "E"
End If
End Sub

This Code For Transfer Data to Sheet4(Database) Departure Data And CallCMD2 And CMD5
Private Sub CommandButton1_Click()
Dim RNG1 As Long
'Save To database(sheet4)
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
With Sheet4
.Range("A" & RNG1) = RNG1 + 100
.Range("B" & RNG1) = Me.Date1
.Range("C" & RNG1) = Format(Time, "HH:MM AM/PM")
.Range("D" & RNG1) = Me.AGR1.Value
.Range("E" & RNG1) = Me.TB1                        'Renter Name
.Range("F" & RNG1) = Me.TB2                        'Cntact
.Range("G" & RNG1) = Me.IDBox                      'Idbox
.Range("H" & RNG1) = Me.TB3                        'PP No
.Range("i" & RNG1) = Me.TB4                        'Driver Name
.Range("j" & RNG1) = Me.TB5                        'Nationality
.Range("K" & RNG1) = Me.TB6                        'Contact
.Range("L" & RNG1) = Me.TB7                        'Driving License No
.Range("M" & RNG1) = Me.TB8                        'Place If Issue
.Range("N" & RNG1) = Me.TB9                        'Expiry date
.Range("O" & RNG1) = Me.ComboBox1                  'Expiry date
.Range("P" & RNG1) = Me.TB12                       'Vehicle Name
.Range("Q" & RNG1) = Date                          'DPT date
.Range("R" & RNG1) = Format(Time, "HH:MM AM/PM")   'DPT Time
.Range("V" & RNG1) = Me.TB11                       'Rent per Day
.Range("AE" & RNG1) = "On Departure"                       'Rent per Day
End With
Call CommandButton2_Click   'Clear Sheet3 Invoice Sheet And fill
If MsgBox("You want print agreement?", vbYesNo) = vbYes Then
Call CommandButton5_Click  'PrintOut
 End If
End Sub
This Code For Clear Data To Sheet3(Invoice) And Yransfer Data To sheet3 (Invoice)
Private Sub CommandButton2_Click()
With Sheet3
'Clear Invoice (Sheet3)
.Range("E" & 4) = ""
.Range("C" & 5) = ""
.Range("B" & 7) = ""
.Range("D" & 9) = ""                         'Renter Name
.Range("D" & 10) = ""
.Range("C" & 12) = ""
.Range("D" & 12) = ""
.Range("E" & 12) = ""
.Range("D" & 13) = ""                        'Driver Name
.Range("D" & 14) = ""                        'Nationality
.Range("D" & 15) = ""                        'Contact
.Range("D" & 16) = ""                        'Driving License No
.Range("D" & 17) = ""                        'Place If Issue
.Range("D" & 18) = ""                        'Expiry date
.Range("C" & 20) = ""                        'Dep Date
.Range("E" & 20) = ""                        'Dpt Time
.Range("C" & 22) = ""
.Range("E" & 22) = ""
.Range("E" & 23) = ""                        'Expiry date
.Range("E" & 24) = ""                        'Vehicle Name
.Range("E" & 25) = ""
.Range("E" & 26) = ""
.Range("E" & 27) = ""
.Range("E" & 28) = ""
.Range("E" & 29) = ""
.Range("E" & 30) = ""
.Range("E" & 31) = ""
'Fill invoice (sheet3)
.Range("E" & 4) = Me.Date1
.Range("C" & 5) = Format(Me.Time1, "HH:MM AM/PM")
.Range("B" & 7) = Me.AGR1.Value                 'Agreement No
'.Range("E" & 7) = Me.AGR1.Value                 'Agreement No
.Range("D" & 9) = Me.TB1                        'Renter Name
.Range("D" & 10) = Me.TB2                        'Cntact
Dim RN As String
RN = Me.TBRange  'Range
.Range(RN & 12) = Me.TB3                         'Id No,Passport No,Other
.Range("D" & 13) = Me.TB4                        'Driver Name
.Range("D" & 14) = Me.TB5                        'Nationality
.Range("D" & 15) = Me.TB6                        'Contact
.Range("D" & 16) = Me.TB7                        'Driving License No
.Range("D" & 17) = Me.TB8                        'Place If Issue
.Range("D" & 18) = Me.TB9                        'Expiry date
.Range("C" & 20) = Me.Date1                      'Dep Date
.Range("E" & 20) = Format(Me.Time1, "HH:MM AM/PM")   'Dpt Time
.Range("E" & 23) = Me.ComboBox1                  'Expiry date
.Range("E" & 24) = Me.TB12                       'Vehicle Name
.Range("E" & 25) = Format(Me.TB11.Value, "#####.00")   'Rent per Day
End With
End Sub

This Code For Clear Transfer Arrival Data To sheet4 And Call CMD2 And CMD5
Private Sub CommandButton3_Click()
Unload Me
UserForm2.Show
End Sub
Private Sub CommandButton4_Click()
Dim RNG1, X As Long
'Fill To Database(sheet4) arrival data
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
For X = 2 To RNG1
If Sheet4.Cells(X, "D") = Val(Me.AGR2) Then
With Sheet4
.Range("S" & X) = Me.ArrDate          'Arrival Date
.Range("T" & X) = Me.ARRTime          'Arrival Time
.Range("U" & X) = Me.TB13.Value       'Total Day
.Range("W" & X) = Me.TB15.Value       'Total rent Amount
.Range("X" & X) = Me.TB17.Value       'Extra Amount
.Range("Y" & X) = Me.TB18.Value       'Traffic fine
.Range("Z" & X) = Me.TB19.Value       'Parking fine
.Range("AB" & X) = Me.TB20.Value      'Total Amount
.Range("AC" & X) = Me.TB21.Value      'Paid Amount
.Range("AD" & X) = Me.TB22.Value      'Balance Amount
.Range("AE" & X) = "Arrived"          'Status
End With
End If
Next X
Call CommandButton2_Click  'for Printsheet(sheet3) Clear And fill departure Data
'fill Printsheet(sheet3)Arrival data
Sheet3.Range("C22") = Me.ArrDate
Sheet3.Range("E22") = Me.ARRTime
Sheet3.Range("E26") = Me.TB13.Value
Sheet3.Range("E27") = Me.TB15.Value
Sheet3.Range("E28") = Me.TB17.Value
Sheet3.Range("E29") = Me.TB18.Value
Sheet3.Range("E30") = Me.TB19.Value
Sheet3.Range("E31") = Me.TB20.Value
If MsgBox("You want print agreement?", vbYesNo) = vbYes Then
Call CommandButton5_Click   'for printout
 End If
Unload Me
UserForm2.Show
End Sub
Private Sub CommandButton5_Click()
'Printout
Application.ScreenUpdating = False
With Sheet3
.Range("B2:E39").PrintOut
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA4
End With
Application.ScreenUpdating = True
End Sub
This Code or Textbox Date format
Private Sub TB9_AfterUpdate()
On Error Resume Next
Me.TB9 = CDate(Me.TB9)  'Dateformat
End Sub
By on

No comments:

Post a Comment

Please do not enter any spam message in comment box

Subscribe to: Post Comments (Atom)