Next Chapter 26 Bill Master

Bill Master

'******************************************************************

'******************************************************************

'** Author : Sameeullah

'** Phone No. : 0522-2647794

'** Mob. No. : 0522-9838068153

'** E-Mail : Welcome2001@indiatimes.comm

'** Subject : Item Group Creation DialogBox

'** Date : Friday, August, 01, 2003

'** Modified : Saturday, August, 02, 2003

'******************************************************************

'******************************************************************

Dim ADDMode As Boolean

Dim EditMode As Boolean

Dim Conn1 As New ADODB.Connection

Private Sub AddCmd_Click()

Dim Discription, BillCode, amount As String

Call SetControls(False)

Discription = InputBox("Enter Bill Name", "Bill Entry", , Me.Left + Me.Width + 50, 1050)

If Trim(Discription) = "" Then GoTo ExitLable

up:

amount = InputBox("Enter Bill Amount", "Bill Entry", , Me.Left + Me.Width + 50, 1050 + 1050)

If Not IsNumeric(amount) And Not Trim(amount) = "" Then GoTo up

If Trim(amount) = "" Then amount = 0

Dim IGRst As New ADODB.Recordset

IGRst.CursorLocation = adUseClient

Conn1.BeginTrans

BillCode = GetNextCode()

IGRst.Open "BillMast", Conn1, adOpenKeyset, adLockOptimistic, adCmdTable

With IGRst

.AddNew

!BillCode = BillCode

!Discription = StrConv(Trim(Left(Discription, 50)), vbProperCase)

!amount = StrConv(Trim(Left(amount, 50)), vbProperCase)

.Update

End With

Conn1.CommitTrans

Call PopulateDieseList

DieseList.SetFocus

ExitLable:

Call SetControls(True)

End Sub

Private Sub ExitCmd_Click()

Unload Me

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyEscape Then Unload Me

End Sub

Private Sub Form_Load()

Set Conn1 = New ADODB.Connection

Conn1.CursorLocation = adUseClient

Conn1.Open ConnectString

Call PopulateDieseList

End Sub

Private Sub PopulateDieseList()

'To populating all groups in list

Dim SQL As String

Dim rst As New ADODB.Recordset

rst.CursorLocation = adUseClient

SQL = "SELECT * FROM BillMast Order By Discription"

rst.Open SQL, Conn1, adOpenForwardOnly, adLockReadOnly, adCmdText

DieseList.View = lvwReport

DieseList.ColumnHeaders(1).Width = 4151.41 'Bill Name

DieseList.ColumnHeaders(2).Width = 1000 'Bill Amount

DieseList.ColumnHeaders(3).Width = 0 'Bill Code

DieseList.ListItems.Clear

Do Until rst.EOF

With DieseList.ListItems.Add(, , rst!Discription)

.ListSubItems.Add , , rst!amount

.ListSubItems.Add , , rst!BillCode

End With

rst.MoveNext

Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error Resume Next

Conn1.Close

Set Conn1 = Nothing

End Sub

Private Sub DieseList_AfterLabelEdit(Cancel As Integer, NewString As String)

On Error GoTo ErrLbl

Dim BillCode, SQL As String

Dim Index As Integer

If DieseList.SelectedItem Is Nothing Then Exit Sub

Index = DieseList.SelectedItem.Index

If Trim(NewString) = "" Then

Cancel = True

MsgBox "Value cannot be blank.", vbCritical, "Editing aborted"

GoTo EndLabel

End If

Dim IGRst As New ADODB.Recordset

IGRst.CursorLocation = adUseClient

Conn1.BeginTrans

BillCode = DieseList.SelectedItem.SubItems(2)

SQL = "SELECT * FROM BillMast WHERE BillCode = " & BillCode & ""

IGRst.Open SQL, Conn1, adOpenKeyset, adLockOptimistic, adCmdText

With IGRst

!Discription = StrConv(Trim(Left(NewString, 50)), vbProperCase)

!amount = StrConv(Trim(Left(DieseList.SelectedItem.SubItems(1), 50)), vbProperCase)

.Update

End With

Conn1.CommitTrans

Call PopulateDieseList

DieseList.ListItems(Index).Selected = True

EndLabel:

DieseList.SetFocus

Call SetControls(True)

Exit Sub

ErrLbl:

ErrHandler "IGFrm.AfterLableEdit"

End Sub

Private Sub DieseList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

With DieseList

.SortKey = ColumnHeader.Index - 1

.SortOrder = IIf(.SortOrder = lvwAscending, lvwDescending, lvwAscending)

.Sorted = True

End With

End Sub

Private Sub DieseList_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyF2 Then

DieseList.StartLabelEdit

ElseIf KeyCode = vbKeyF3 Then

Call UpdateAmount

ElseIf KeyCode = vbKeyDelete Then

If MsgBox("This will delete selected item [" & DieseList.SelectedItem.Text & "] from the list. Are you sure to do this.", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Exit Sub

Conn1.BeginTrans

Conn1.Execute "Delete FROM BillMast WHERE BillCode = " & DieseList.SelectedItem.SubItems(2) & "", , adCmdText

Conn1.CommitTrans

Call PopulateDieseList

DieseList.SetFocus

End If

End Sub

Private Sub SetControls(ByVal Status As Boolean)

AddCmd.Enabled = Status

ExitCmd.Enabled = Status

End Sub

Private Function GetNextCode() As String

Dim RS As New ADODB.Recordset

RS.Open "Select Max(BillCode) From BillMast", Conn1, adOpenDynamic, adLockOptimistic

GetNextCode = GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 4)

End Function

Public Sub UpdateAmount()

On Error GoTo ErrLbl

Dim BillCode, amount As String

Dim Index As Integer

If DieseList.SelectedItem Is Nothing Then Exit Sub

Index = DieseList.SelectedItem.Index

amount = InputBox("Enter Bill Amount", "Bill Entry", DieseList.SelectedItem.SubItems(1), Me.Left + Me.Width + 50, 1050 + 1050)

If amount = "" Then Exit Sub '******************** Skip On Cancel Press

If Not IsNumeric(amount) And Trim(amount) = "" Then MsgBox "Please Enter Valid Amount", vbInformation, "Validation Error": Exit Sub

Dim IGRst As New ADODB.Recordset

IGRst.CursorLocation = adUseClient

Conn1.BeginTrans

BillCode = DieseList.SelectedItem.SubItems(2)

IGRst.Open "SELECT * FROM BillMast WHERE BillCode = " & BillCode & "", Conn1, adOpenKeyset, adLockOptimistic, adCmdText

With IGRst

!amount = StrConv(Trim(Left(amount, 50)), vbProperCase)

.Update

End With

Conn1.CommitTrans

Call PopulateDieseList

DieseList.ListItems(Index).Selected = True

EndLabel:

DieseList.SetFocus

Call SetControls(True)

Exit Sub

ErrLbl:

ErrHandler "IGFrm.AfterLableEdit"

End Sub

Private Sub PrintCmd_Click()

BillMasterReport.Show

End Sub

Sponsored Links

Next Chapter 27 Bills