Create Deposit And withdrawal Transaction form Multipage Excel VBA

Create Deposit And withdrawal Transaction form Multipage Excel VBA

In This Video I showing how to create Transaction deposit and withdrawing form And searching Transaction by account number And printout Thank you

इस वीडियो में मैं दिखा रहा हूं कि ट्रांजेक्शन डिपॉजिट और निकासी कैसे करें फ़ॉर्म और खाता संख्या और प्रिंटआउट द्वारा लेनदेन खोज धन्यवाद

في هذا الفيديو ، أوضح كيفية إنشاء إيداع وسحب المعاملاتشكل والبحث عن المعاملات برقم الحساب والطباعة شكراً لك

Watch Video

VBA Code

Userform1

Initialize

Private Sub UserForm_Initialize()

Me.TextBox1.SetFocus        'Page1 Recept Voucher

Me.TextBox9 = CDate(Date)   'Page1 Recept Voucher

Me.TextBox19 = CDate(Date)  'Page2 Payment Voucher

'Multipage Format

Me.MultiPage1.BackColor = &H80000003

Me.MultiPage1.Left = 8

Me.TextBox25 = CDate(Date)

With Sheet3.Range("A1000000").End(xlUp)

'Reference number project

Me.TextBox21 = 110100 + .Row  'Page3  Create Account

End With

End Sub

Private Sub TextBox3_Change() 'Page1 Recept Voucher

'Page1 Recept Voucher

On Error Resume Next

Me.TextBox4 = Format(Val(Me.TextBox2) + Val(Me.TextBox3), "#####.00")

If Val(Me.TextBox3) >= 1 Then

Me.CommandButton2.Enabled = True

Else

Me.CommandButton2.Enabled = False

End If

End Sub

Search Button

Private Sub CommandButton1_Click() 'Page1 Recept Voucher 'Page1 Recept Voucher Dim MyRow As Long Dim CRD, DBT As Long Me.Label34.Visible = False With Sheet3 On Error Resume Next MyRow = Application.WorksheetFunction.Match(Val(Me.TextBox1), .Range("A:A"), 0) Me.TextBox5 = .Cells(MyRow, "B") 'Ac Name Me.TextBox6 = .Cells(MyRow, "C") 'Cntact No Me.TextBox7 = .Cells(MyRow, "D") 'Address Me.TextBox8 = .Cells(MyRow, "E") 'Opening Dtae Me.TextBox10 = .Cells(MyRow, "A") 'Ac number 'Credit Amount Total 'Colmn(D:D) Credit Amount Account Number CRD = Application.WorksheetFunction.SumIfs(Sheet2.Range("D:D"), Sheet2.Range("B:B"), Val(Me.TextBox1)) 'Debit Amount Total 'Colmn(E:E) Debit Amount 'Account Number DBT = Application.WorksheetFunction.SumIfs(Sheet2.Range("E:E"), Sheet2.Range("B:B"), Val(Me.TextBox1)) 'Credit - Debit Me.TextBox2 = Format(Val(CRD - DBT), "#####.00") End With Me.TextBox3.SetFocus End Sub

Save Button

Private Sub CommandButton2_Click() 'Page1 Recept Voucher

'Page1 Recept Voucher

With Sheet2.Range("A1000000").End(xlUp) 'Database

On Error Resume Next

.Offset(1, 0) = CDate(Me.TextBox9)   'Date

.Offset(1, 1) = Val(Me.TextBox10)    'Dccount no

Offset(1, 2) = Me.TextBox5.Value    'Name

.Offset(1, 3) = Me.TextBox3.Value    'Credit Amount

.Offset(1, 5) = .Row + 100           'Reference No

End With

For i = 1 To 9

Me("textbox" & i) = ""

Next i

Me.TextBox9 = CDate(Date)

Me.TextBox1.SetFocus

Me.Label34.Visible = True

End Sub

Private Sub TextBox13_Change() 'Page2  Payment Voucher

'Page2  Payment Voucher

On Error Resume Next

                    'Current Balance    - Debit Amount

Me.TextBox14 = Format(Val(Me.TextBox12) - Val(Me.TextBox13), "#####.00")

   'Payment Amount      'Current BAlance Amount

If Val(Me.TextBox13) <= Val(Me.TextBox12) Then

Me.CommandButton4.Enabled = True

Me.Label27.Caption = ""   'Label ("Sorry Not Enogh Amount)

Else

Me.CommandButton4.Enabled = False  'Save Button

Me.Label27.Caption = "Sorry Not Enough Amount"

End If

End Sub

Search Button

Private Sub CommandButton3_Click() 'Page2 Payment Voucher 'Page2 Payment Voucher Dim MyRow As Long Dim CRD, DBT As Long Me.Label35.Visible = False With Sheet3 'Ledger On Error Resume Next MyRow = Application.WorksheetFunction.Match(Val(Me.TextBox11), .Range("A:A"), 0) Me.TextBox20 = .Cells(MyRow, "A") 'Account Number Me.TextBox15 = .Cells(MyRow, "B") 'Account Name Me.TextBox16 = .Cells(MyRow, "C") 'Cntact No Me.TextBox17 = .Cells(MyRow, "D") 'Address Me.TextBox18 = .Cells(MyRow, "E") 'Opening Date 'Credit Amount Total CRD = Application.WorksheetFunction.SumIfs(Sheet2.Range("D:D"), Sheet2.Range("B:B"), Val(Me.TextBox11)) 'Debit Amount Total DBT = Application.WorksheetFunction.SumIfs(Sheet2.Range("E:E"), Sheet2.Range("B:B"), Val(Me.TextBox11)) 'Credit - Debit Me.TextBox12 = Format(Val(CRD - DBT), "#####.00") End With Me.TextBox13.SetFocus End Sub

Save Button

Private Sub CommandButton4_Click() 'Page2 Payment Voucher

'Page2 Payment Voucher

With Sheet2.Range("A1000000").End(xlUp)

On Error Resume Next

.Offset(1, 0) = CDate(Me.TextBox19)  'Date

.Offset(1, 1) = Val(Me.TextBox20)    'Acoount Number

.Offset(1, 2) = Me.TextBox15.Value   'Ac Name

.Offset(1, 4) = Me.TextBox13.Value   'Debit Amount

.Offset(1, 5) = .Row + 100           'Reference Amount

End With

For i = 11 To 20

Me("textbox" & i) = ""     'All Textbox Clear

Next i

Me.TextBox19 = CDate(Date) 'Current Date

Me.TextBox11.SetFocus

Me.Label35.Visible = True

End Sub

Private Sub TextBox22_Change() 'Page3  Create Account

'Page3  Create Account

On Error Resume Next

Me.TextBox22 = Format(StrConv(Me.TextBox22, vbProperCase))

Me.Label36.Visible = False

Me.Label37.Visible = False

Me.Label38.Visible = False

End Sub

Save button

Private Sub TextBox24_Change() 'Page3  Create Account

'Page3  Create Account

On Error Resume Next

Me.TextBox24 = Format(StrConv(Me.TextBox24, vbProperCase))

End Sub

Private Sub CommandButton5_Click() 'Page3 Create Account

'Page3 Create Account

If Me.TextBox22 = "" Or Me.TextBox23 = "" Or Me.TextBox24 = "" Then

MsgBox "Please Please Fill Complete"

Else

With Sheet3.Range("A1000000").End(xlUp)

.Offset(1, 0) = Me.TextBox21.Value      'Account Number

.Offset(1, 1) = Me.TextBox22.Value      'Account Name

.Offset(1, 2) = Me.TextBox23.Value      'Contact Number

.Offset(1, 3) = Me.TextBox24.Value      'Address

.Offset(1, 4) = Me.TextBox25.Value      'Ac Opening Date

Me.Label37.Visible = True

Me.Label38.Visible = True

Me.Label37.Caption = "Account No     : " & Me.TextBox21.Value

Me.Label38.Caption = "Account Name: " & Me.TextBox22

Me.TextBox21 = Me.TextBox21 + 1         'Project New Ac Number

Me.TextBox22 = ""

Me.TextBox23 = ""

Me.TextBox24 = ""

Me.TextBox25 = ""

Me.TextBox22.SetFocus

Me.Label36.Visible = True

Me.Label37.Visible = True

Me.Label38.Visible = True

End With

End If

Me.TextBox25 = Date

End Sub

Worksheet

Private Sub CommandButton1_Click() 'Sheet1.Search form

Dim MyRow, ERow As Long

Application.ScreenUpdating = False

'Sheet1.Unprotect Password:=""

On Error Resume Next                                          'Sheet3("Ledger")

MyRow = Application.WorksheetFunction.Match(Val(Me.TextBox1), Sheet3.Range("A:A"), 0)

'Header              'Sheet3("Ledger")

Sheet1.Range("C4") = Sheet3.Cells(MyRow, "A")   'Account No

Sheet1.Range("C5") = Sheet3.Cells(MyRow, "B")   'Name

Sheet1.Range("C6") = Sheet3.Cells(MyRow, "C")   'Contact No

Sheet1.Range("C7") = Sheet3.Cells(MyRow, "D")   'Address

Sheet1.Range("C8") = Sheet3.Cells(MyRow, "E")   'Ac Opning Date

Sheet1.Range("F4") = Format(Date, "DD/MMM/YYYY")  'Date

Sheet1.Range("F5") = Format(Time, "HH:MM AM/PM")  'time

'Data

'Sheet1("Home")

ERow = Sheet1.Range("E1000000").End(xlUp).Row + 1

Sheet1.Range("B" & 10, "F" & ERow).ClearContents     'clear sheet1

Sheet1.Range("B" & 10, "F" & ERow).Font.Size = 8

Sheet1.Range("B" & 4, "F" & ERow).Font.Bold = True

Sheet1.Range("D" & 10, "F" & ERow).HorizontalAlignment = xlRight

Sheet1.Range("D" & 10, "F" & ERow).NumberFormat = "#####.00"

             'Sheet2("Database")

For i = 2 To Sheet2.Range("A100000").End(xlUp).Row

With Sheet1.Range("B1000000").End(xlUp)

If Sheet2.Cells(i, "B") = Val(Me.TextBox1) Then

.Offset(1, 0) = Sheet2.Cells(i, "A")    'Date

.Offset(1, 1) = Sheet2.Cells(i, "F")    'refrence          '

.Offset(1, 2) = Sheet2.Cells(i, "D")    'Credit

.Offset(1, 3) = Sheet2.Cells(i, "E")    'Debit

'Runningbalance

'Runninbalance   Credit       -  Debit

.Offset(1, 4) = .Offset(1, 2) - .Offset(1, 3)

'Runnib balance   Credit-  Debit

                'Previous Date  'credit         'Debit

.Offset(1, 4) = .Offset(0, 4) + .Offset(1, 2) - .Offset(1, 3)

End If

End With

Next i

With Sheet1.Range("B1000000").End(xlUp)

'Cells Formt

.Offset(1, 3) = "Available Balance"

.Offset(1, 3).Font.Size = 11

.Offset(1, 3).Font.Bold = True

.Offset(1, 4).Font.Size = 11

.Offset(1, 4) = .Offset(0, 4)      'Balance Amount

.Offset(1, 4).Font.Bold = True

'Underline

.Offset(2, 1) = "______________________________"

.Offset(2, 2) = "___________________________"

.Offset(2, 3) = "______________________"

.Offset(2, 4) = "_____________________"

'company Details

.Offset(3, 1) = "Appllo"

.Offset(3, 1).Font.Size = 8

.Offset(3, 2) = "Contact"

.Offset(3, 2).Font.Size = 8

.Offset(3, 3) = Format(221234568, "###-####-###")

.Offset(3, 3).NumberFormat = "General"

.Offset(3, 3).Font.Size = 8

.Offset(3, 3).HorizontalAlignment = xlLeft

'Offset(3, 3).NumberFormat=

.Offset(3, 4) = "@gmail.com"

.Offset(3, 4).Font.Size = 8

.Offset(3, 4).HorizontalAlignment = xlLeft

.Offset(3, 4).NumberFormat = "General"

End With

'Sheet1.Protect Password:=""

Application.ScreenUpdating = True

End Sub

Ptrint

Private Sub CommandButton2_Click()

Dim MyRow As Long

MyRow = Sheet1.Range("E1000000").End(xlUp).Row

Sheet1.Range("B" & 1, "F" & MyRow).PrintOut

End Sub