Next chapter 40 Account Group Form
PROJECT SOURCE CODE
SPONSORED LINKS
Account Group Form
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Group Creation DialogBox
'** Date : Friday, July, 25, 2003
'** Modified : Wednesday, July, 30, 2003
'******************************************************************
'******************************************************************
Dim ADDMode As Boolean
Dim EditMode As Boolean
Private Sub AddCmd_Click()
If AddCmd.Caption = "&Add" Then
ADDMode = True
Call SetControls
GrpTxt.Text = ""
GrpTxt.Tag = ""
ParentTxt.Text = ""
ParentTxt.Tag = ""
AliasTxt.Text = ""
BsheetChk.Value = vbUnchecked
GrpTxt.SetFocus
Else
If Not (GrpTxt.Text = "" And GrpTxt.Tag = "" And ParentTxt.Text = "" And ParentTxt.Tag = "") Then
If Not SavedData Then Exit Sub
Call MakeNormal
Call PopulateGroupList
End If
End If
End Sub
Private Sub EditCmd_Click()
If EditCmd.Caption = "&Edit" Then
EditMode = True
Call SetControls
GrpTxt.SetFocus
Else
Call MakeNormal
End If
End Sub
Private Sub ExitCmd_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
If ADDMode Or EditMode Then
Call MakeNormal
Else
Unload Me
End If
ElseIf KeyCode = vbKeyReturn And Not (Me.ActiveControl.Name = "ParentTxt") Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Form_Load()
Call PopulateGroupList
With PrntSrch
.DBConnectString = ConnectString
.SQLString = "SELECT ACCODE, ACDESC, ACALIAS FROM ACMAST WHERE RECTYPE = 'G'"
.Title = "Parent Groups List"
.ReturnField = vCompanyName
Set .BoundTextBox = ParentTxt
.PopulateList
End With
End Sub
Private Sub PopulateGroupList()
'To populating all groups in list
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
SQL = "SELECT * FROM ACCOUNTS WHERE RECTYPE = 'G'"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
GroupList.View = lvwReport
GroupList.ColumnHeaders(1).Width = 4501.41 'Account Desc
GroupList.ColumnHeaders(2).Width = 0 'Accode
GroupList.ColumnHeaders(3).Width = 3440.12 'Group Desc
GroupList.ColumnHeaders(4).Width = 0 'GrCode
GroupList.ColumnHeaders(5).Width = 0 'Modify
GroupList.ColumnHeaders(6).Width = 0 'Alias
GroupList.ColumnHeaders(7).Width = 0 'BSheet
GroupList.ListItems.Clear
Do Until rst.EOF
With GroupList.ListItems.Add(, , rst!AcDESC)
.ListSubItems.Add , , rst!AcCode
.ListSubItems.Add , , IIf(IsNull(rst!GROUPDESC), "", rst!GROUPDESC)
.ListSubItems.Add , , IIf(IsNull(rst!GrCode), "", rst!GrCode)
.ListSubItems.Add , , IIf(IsNull(rst!Modify), "", rst!Modify)
.ListSubItems.Add , , IIf(IsNull(rst!ACALIAS), "", rst!ACALIAS)
.ListSubItems.Add , , rst!bsheet
If rst!Modify = "N" Then
.ForeColor = vbRed
.ListSubItems(1).ForeColor = vbRed
.ListSubItems(2).ForeColor = vbRed
.ListSubItems(3).ForeColor = vbRed
.ListSubItems(4).ForeColor = vbRed
End If
End With
rst.MoveNext
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
End Sub
Private Sub GroupList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With GroupList
.SortKey = ColumnHeader.Index - 1
.SortOrder = IIf(.SortOrder = lvwAscending, lvwDescending, lvwAscending)
.Sorted = True
End With
End Sub
Private Sub GroupList_ItemClick(ByVal Item As MSComctlLib.ListItem)
If ADDMode Or EditMode Then Exit Sub
With GroupList
GrpTxt.Text = Item.Text
GrpTxt.Tag = Item.SubItems(1)
ParentTxt.Text = Item.SubItems(2)
ParentTxt.Tag = Item.SubItems(3)
EditCmd.Enabled = Not Item.SubItems(4) = "N"
AliasTxt.Text = Item.SubItems(5)
BsheetChk.Value = Abs(IIf(Item.SubItems(6) = "", 0, Item.SubItems(6)))
End With
End Sub
Private Sub SetControls()
Frame1.Enabled = ADDMode Or EditMode
GroupList.Enabled = Not (ADDMode Or EditMode)
ExitCmd.Enabled = Not (ADDMode Or EditMode)
AddCmd.Caption = IIf(ADDMode Or EditMode, "&Save", "&Add")
EditCmd.Caption = IIf(ADDMode Or EditMode, "&Cancel", "&Edit")
EditCmd.Enabled = (ADDMode Or EditMode)
EditCmd.Cancel = (ADDMode Or EditMode)
AddCmd.ToolTipText = IIf((ADDMode Or EditModes), "Click to save record", "Click to add a new group")
EditCmd.ToolTipText = IIf((ADDMode Or EditModes), "Click to cancel adding/editing", "Click to edit selected group")
If Not (ADDMode Or EditModes) Then PrntSrch.HideList
End Sub
Private Sub MakeNormal()
ADDMode = False
EditMode = False
Call SetControls
End Sub
Private Function SavedData() As Boolean
On Error GoTo ErHand
Dim SQL, vCode As String
Dim GrpRst As New ADODB.Recordset
Dim ACRst As New ADODB.Recordset
SQL = "SELECT * FROM ACMAST WHERE ACCODE = '" & ParentTxt.Tag & "'"
GrpRst.CursorLocation = adUseClient
GrpRst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Dim ACTrans As New ADODB.Recordset
ACTrans.CursorLocation = adUseClient
If Not (GrpRst.RecordCount > 0) Then
MsgBox "Invalid Parent Group.", vbCritical
Exit Function
End If
If ADDMode Then
SQL = "SELECT * FROM ACMAST"
Else
SQL = "SELECT * FROM ACMAST WHERE ACCODE = '" & GrpTxt.Tag & "'"
End If
ACRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If EditMode Then
If Not (ACRst.RecordCount > 0) Then
MsgBox "Please select group from group list to edit.", vbCritical
End If
End If
Conn.BeginTrans
'Update ACTrans Closing
If EditMode Then
SQL = "SELECT * FROM ACTRANS WHERE ACCODE = '" & GrpTxt.Tag & "'"
ACTrans.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not (ACTrans.RecordCount > 0) Then
MsgBox "Selected Group Entry is not found in ACTRANS Table.", vbCritical, "Record missing"
Exit Function
ElseIf ACTrans!CLOSING <> 0 Then
Call BalancePost(EditPosting, ACTrans!CLOSING, ACTrans!Cr_Dr, GrpTxt.Tag, Conn)
End If
End If
If ADDMode Then vCode = GetAccountCode()
If ADDMode Then ACRst.AddNew: ACRst!AcCode = vCode
ACRst!Modify = "Y"
ACRst!AcDESC = GrpTxt.Text
ACRst!ACALIAS = AliasTxt.Text
ACRst!RECTYPE = IIf(IsNull(GrpRst!RECTYPE), "", GrpRst!RECTYPE)
ACRst!CASH = IIf(IsNull(GrpRst!CASH), "", GrpRst!CASH)
ACRst!GrCode = IIf(IsNull(GrpRst!AcCode), "", GrpRst!AcCode)
ACRst!ACTYPE = IIf(IsNull(GrpRst!ACTYPE), "", GrpRst!ACTYPE)
ACRst!Level = IIf(IsNull(GrpRst!Level), "", GrpRst!Level + 1)
ACRst!bsheet = CBool(BsheetChk.Value)
ACRst.Update
If ADDMode Then
'Insert account code to actrans table
SQL = "INSERT INTO ACTRANS (ACCODE, CLOSING, YOBDR, YOBCR, BALANCE) VALUES ('" & vCode & "',0,0,0,0)"
Conn.Execute SQL, , adCmdText
ElseIf EditMode Then
'Update ACTrans Closing
SQL = "SELECT * FROM ACTRANS WHERE ACCODE = '" & GrpTxt.Tag & "'"
If ACTrans.State = adStateOpen Then ACTrans.Close
ACTrans.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not (ACTrans.RecordCount > 0) Then
MsgBox "Selected Group Entry is not found in ACTRANS Table.", vbCritical, "Record missing"
Exit Function
ElseIf ACTrans!CLOSING <> 0 Then
Call BalancePost(ADDPosting, ACTrans!CLOSING, ACTrans!Cr_Dr, GrpTxt.Tag, Conn)
End If
End If
Conn.CommitTrans
SavedData = True
Exit Function
ErHand:
ACRst.CancelUpdate
Conn.RollbackTrans
If err.Number = -2147217887 Then 'Unique Index or Primary Key Voilated
MsgBox "The record you are trying to save could not successful because it would create the duplicate value in alias field. Please change the Alias value.", vbCritical, "Duplicate Alias"
SelectText AliasTxt
Else
ErrHandler "Function SavedData"
End If
End Function
Function GetAccountCode() As String
Dim RS As New ADODB.Recordset
RS.Open "Select Max(ACCODE) From ACMAST", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then GetAccountCode = GetProperCode(IIf(IsNull(RS(0)), "1", Mid(RS(0), 2) + 1), 6) Else GetAccountCode = GetProperCode("1", 6)
End Function
Private Sub GroupList_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo DelErrhandler
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If Not KeyCode = vbKeyDelete Then Exit Sub
If GroupList.SelectedItem Is Nothing Then Exit Sub
If GroupList.SelectedItem.SubItems(4) = "N" Then Exit Sub
If MsgBox("Are you sure to delete selected group.", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then GroupList.SetFocus: Exit Sub
Conn.BeginTrans
SQL = "SELECT COUNT(*) FROM ACMAST WHERE GRCODE = '" & GroupList.SelectedItem.SubItems(1) & "'"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not (rst(0) > 0) Then
SQL = "DELETE FROM ACMAST WHERE ACCODE = '" & GroupList.SelectedItem.SubItems(1) & "'"
Conn.Execute SQL, , adCmdText
SQL = "DELETE FROM ACTRANS WHERE ACCODE = '" & GroupList.SelectedItem.SubItems(1) & "'"
Conn.Execute SQL, , adCmdText
Conn.CommitTrans
Call PopulateGroupList
Else
Conn.RollbackTrans
MsgBox "The group you are trying to delete could not be successful because it is the parent group of some subgroup.", vbCritical, "Deletion Aborted"
End If
GroupList.SetFocus
Exit Sub
DelErrhandler:
Conn.RollbackTrans
ErrHandler "GroupList_KeyDown"
End Sub
Sponsored Links