1 Replies - 891 Views - Last Post: 10 September 2010 - 02:59 PM Rate Topic: -----

#1 Avinash Purat  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 2
  • Joined: 30-August 10

Entering autonumber in datagrid

Posted 10 September 2010 - 06:12 AM

Dear Sirs/Madams,

I have a datagrid in my form and the database is MS Access. First column in the datagrid is Sr. No. for the record, which is generated automatically in the code.

My difficulty is when a record is deleted from the database, the Sr. No. should be rearranged. For example, from the 8 records I have, if I delete record no. 6, record nos. 7 & 8 Sr. Nos. should be changed to 6 & 7 respectively. This is not taking place due to some problem in the code which I am unable to debug.

I want your help in solving this problem.

Thanking you in anticipation,

Yours sincerely

Avinash Purat.

frm_society_flats
Option Explicit
Dim rsMaster As New ADODB.Recordset
Dim rsDetail(0) As New ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim obj(0) As New clsGrdFunctions
Dim objMaster As New clsGrdFunctions
Dim bMasterAdd As Boolean
Dim bChange As Boolean
Dim bMChange As Boolean 'When Master is changed
Dim badded(0) As Boolean
Dim bDeleted(0) As Boolean ' When Detail Record In Grid is Deleted
Dim bQEnter As Boolean 'When in enter mode
Dim bExit As Boolean 'When form is closed
Dim bDetailFocous(0) As Boolean 'When Focous is On Detail
Dim bApproveFocous(0) As Boolean
Dim bFirstEdit As Boolean
Dim iRecCount(0) As Integer
Dim iValidate As Integer
Dim strSql As String
Dim arrColMaster() As String
Dim arrColDetail() As String
Dim arrColDetail1() As String
Dim sTmpMaster As String ' Temp Master Table Name
Dim sTmpDetail(0) As String ' Temp Detil Table Name
Dim iResp As Integer 'General Variable to get response from functions
Dim arrVal() As Variant
Dim cnn1 As New Connection
Dim g_CnnDb As ADODB.Connection
Dim iNoOfDetails As Integer 'No of details in grids releated to master
Private Sub Form_Load()
Dim sColList As String 'To use in Merge Tables
sColList = "FLAT_SR_NO,BUILDING_NO,BUILDING_NAME,WING," & _
        "FLOOR,FLAT_NO,FLAT_AREA1,AREA_UNIT1,FLAT_AREA2,AREA_UNIT2," & _
        "FLAT_AREA3,AREA_UNIT3,FLAT_VALUE,PURPOSE,TAPS_NO,FLAT_TYPE,SOCIETY_NO,DATE_TODAY"
Call FillArray(arrColDetail(), sColList)

bChange = False
bMasterAdd = False
bQEnter = False
bMChange = False
bExit = False
iNoOfDetails = 1
Dim itr As Integer
For itr = 0 To iNoOfDetails - 1
    badded(itr) = False
    bDeleted(itr) = False
    bDetailFocous(itr) = False
Next
iValidate = 1
'Default Values
txt_date = Format(Date, "dd-MMM-yyyy")
'Show Last Record
Call ShowLastRecord
Call StartUpMenu 'Show Start Up Menu

'---------------------------------------------------------------------
'g_CnnDb.begintrans
'cnn1.BeginTrans
End Sub
Private Sub ShowLastRecord()
    Dim bTemp, bTemp1 As Boolean
    bTemp = bMChange 'Save Status of bMchange variable
    bTemp1 = bChange 'Save Status of bchange variable
    Call LoadMaster
    Dim itr As Integer
    If rsMaster.RecordCount > 0 Then
        rsMaster.MoveLast
        '        For itr = 0 To iNoOfDetails - 1
            dg_flats.Enabled = True
'        Next
    Else
'        For itr = 0 To iNoOfDetails - 1
            dg_flats.Enabled = False
'        Next
    End If
    Call SetMaster
    For itr = 0 To iNoOfDetails - 1 Step 1
        Call LoadDetails(itr)
        If rsDetail(0).RecordCount > 0 Then rsDetail(0).MoveLast
        bDetailFocous(itr) = True
    Next
    Call SetDateToForm
    'Disable Primary Key Controls
    txt_soc_no.Enabled = False
    bMChange = bTemp 'Reset Status of bMchange variable as it was at start of function
    bChange = bTemp1  'Reset Status of bchange variable as it was at start of function

End Sub
Private Sub StartUpMenu()
If rsMaster.RecordCount > 0 Then
    mnuAction.Enabled = True
    mnuActionSave.Enabled = True
    mnuActionCancel.Enabled = True
    mnuActionExit.Enabled = True
    mnuEdit.Enabled = True
    mnuQuery.Enabled = True
    mnuQueryEnter.Enabled = True
    mnuQueryCancel.Enabled = False
    mnuRecord.Enabled = True
    mnuRecordAdd.Enabled = True
    mnuRecordDelete.Enabled = True
    mnuRecordFirst.Enabled = True
    mnuRecordPrev.Enabled = True
    mnuRecordNext.Enabled = True
    mnuRecordLast.Enabled = True
    mnuwindow.Enabled = True
    mnuWCascade.Enabled = True
    mnuWTile.Enabled = True
    mnuWArrange.Enabled = True
    mnuHelp.Enabled = True
    mnuHelpContents.Enabled = True
Else
    mnuAction.Enabled = True
    mnuActionSave.Enabled = False
    mnuActionCancel.Enabled = False
    mnuActionExit.Enabled = True
    mnuEdit.Enabled = False
    mnuQuery.Enabled = False
    mnuQueryEnter.Enabled = False
    mnuQueryCancel.Enabled = False
    mnuRecord.Enabled = True
    mnuRecordAdd.Enabled = True
    mnuRecordDelete.Enabled = False
    mnuRecordFirst.Enabled = False
    mnuRecordPrev.Enabled = False
    mnuRecordNext.Enabled = False
    mnuRecordLast.Enabled = False
    mnuwindow.Enabled = True
    mnuWCascade.Enabled = True
    mnuWTile.Enabled = True
    mnuWArrange.Enabled = True
    mnuHelp.Enabled = True
    mnuHelpContents.Enabled = True

End If
End Sub
Private Function LoadMaster()
    Set rsMaster = Nothing
    strSql = " SELECT society_no,"
    strSql = strSql & " DATE_TODAY FROM Society " & " ORDER BY 1;"
    Call GetAllRecords(rsMaster, strSql)
    Set rsMaster = deSoc.rscmd_soc
'    If deSoc.rscmd_soc.State = adStateClosed Then deSoc.rscmd_soc.Open
'    If deSoc.rscmd_society_flats.State = adStateClosed Then deSoc.rscmd_society_flats.Open
End Function
Private Function SetMaster()
    If rsMaster.RecordCount > 0 Then
        txt_soc_no = rsMaster.Fields("SOCIETY_NO").Value
    
        Call GetAllRecords(rs, strSql)
        txt_date = rsMaster.Fields("DATE_TODAY")
        txt_date = Format(rsMaster.Fields("DATE_TODAY"), "dd-MMM-yyyy")
    
    Else
        bMChange = False
        txt_date = Format(Date, "dd-MMM-yyyy")
    End If
End Function
Private Sub LoadDetails(ByVal DetailNo As Integer)
    'SR_NO must be the first column
    'The Fields to be shown in grid must be after SR_NO
    'Then invisible fields should follow
    'Last three fields will be DATE_TODAY,ENTRY_BY AND APPROVAL
    If DetailNo = 0 Then _
        strSql = " SELECT FLAT_SR_NO,BUILDING_NO,BUILDING_NAME,WING,FLOOR,"
        strSql = strSql & " FLAT_NO,FLAT_AREA1,AREA_UNIT1,FLAT_AREA2,AREA_UNIT2,"
        strSql = strSql & " FLAT_AREA3,AREA_UNIT3,FLAT_VALUE,PURPOSE, "
        strSql = strSql & " TAPS_NO,FLAT_TYPE,SOCIETY_NO,DATE_TODAY "
        strSql = strSql & " FROM Society_flats "
        strSql = strSql & " WHERE SOCIETY_NO ='" & txt_soc_no & "';"
    '
    obj(0).ReadymadeQuery (strSql)
    Set rsDetail(0) = Nothing
'    obj(DetailNo).ExecuteQuery dg_flats, rsDetail(DetailNo)
    Dim m_QueryString As String
    Dim rr As ADODB.Recordset
    Dim cnn1 As New Connection
    Dim g_CnnDb As ADODB.Connection
    Dim grd As DataGrid
    m_QueryString = strSql
    Set rr = deSoc.rscmd_society_flats
'    ReadymadeQuery = m_QueryString
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\Hsg Soc.mdb;"
'    Set rsDetail(0) = rr
'    If rr.State = 1 Then rr.Close
'    rr.Open m_QueryString, cnn1, adOpenDynamic, adLockOptimistic
'    Set grd.DataSource = rr
    Set rsDetail(0) = rr

    Set obj(0).grdDetail = dg_flats
    iRecCount(0) = rsDetail(0).RecordCount
    Call SetGrid(0)
    Call obj(0).SetGrdVar
    'reset Detail Focous Values
    bDetailFocous(0) = False
End Sub
Private Function SetDetails(DetailNo As Integer)
    If rsDetail(0).RecordCount > 0 Then
        If Not rsDetail(0).BOF And Not rsDetail(0).EOF Then
            txt_date = rsDetail(0).Fields("DATE_TODAY")
            txt_date = Format(rsDetail(0).Fields("DATE_TODAY"), "dd-MMM-yyyy")
        Else
            txt_date = Format(Date, "dd-MMM-yyyy")
        End If
    End If
End Function

Private Sub Form_Unload(Cancel As Integer)
    If iValidate = 0 Or bQEnter = True Then
        Cancel = True
        Exit Sub
    End If
    bExit = True
    If bChange Then
        DoEvents
        If MsgBox("Save all changes?", vbYesNo) = vbYes Then
            mnuActionSave_Click
        Else
            mnuActionCancel_Click
        End If
    Else
        g_CnnDb.CommitTrans
    End If
    'Drop Tmp Tables DetailNo As Integer
    'Drop Tmp Table created at Load Function
    Set rsMaster = Nothing
    gblsForm = ""
End Sub
Private Sub ResetControls()
    Dim X As Control
    For Each X In Me.Controls
        If TypeOf X Is TextBox Then X.Text = ""
    Next
    'Set DEfault Values
    txt_date = Format(Date, "dd-MMM-yyyy")
    Dim itr As Integer
    For itr = 0 To iNoOfDetails - 1
        Call LoadDetails(itr) 'to show grid acording to empty Master
    Next
End Sub
Private Sub SetGrid(DetailNo As Integer)
Dim itr As Integer
With dg_flats

    .Columns(2).Caption = "  Flat Sr.        NO."
    .Columns(3).Caption = "Building     No."
    .Columns(4).Caption = "  Building Name"
    .Columns(5).Caption = "Wing"
    .Columns(6).Caption = "  Floor"
    .Columns(7).Caption = "Flat No."
    .Columns(8).Caption = "Flat Area1"
    .Columns(9).Caption = "Area Unit1"
    .Columns(10).Caption = "Flat Area2"
    .Columns(11).Caption = "Area Unit2"
    .Columns(12).Caption = "Flat Area3"
    .Columns(13).Caption = "Area Unit3"
    .Columns(14).Caption = "Flat Value"
    .Columns(15).Caption = "Purpose"
    .Columns(16).Caption = "No. of Taps"
    .Columns(17).Caption = "Flat Type"
    .Columns(0).Locked = True
    .Columns(0).Visible = False
    .Columns(1).Locked = True
    .Columns(1).Visible = False
    
    .Columns(2).Locked = True
    .Columns(2).Width = 975
    .Columns(3).Width = 800
    .Columns(4).Width = 1600
    .Columns(5).Width = 600
    .Columns(6).Width = 1000
    .Columns(7).Width = 750
    .Columns(8).Width = 800
    .Columns(9).Width = 900
    .Columns(10).Width = 800
    .Columns(11).Width = 900
    .Columns(12).Width = 800
    .Columns(13).Width = 900
    .Columns(14).Width = 900
    .Columns(15).Width = 1750
    .Columns(16).Width = 750
    .Columns(17).Width = 900

    .Columns(2).Alignment = dbgCenter
    .Columns(3).Alignment = dbgCenter
    .Columns(4).Alignment = dbgCenter
    .Columns(5).Alignment = dbgCenter
    .Columns(6).Alignment = dbgCenter
    .Columns(7).Alignment = dbgCenter
    .Columns(8).Alignment = dbgCenter
    .Columns(9).Alignment = dbgCenter
    .Columns(10).Alignment = dbgCenter
    .Columns(11).Alignment = dbgCenter
    .Columns(12).Alignment = dbgCenter
    .Columns(13).Alignment = dbgCenter
    .Columns(14).Alignment = dbgCenter
    .Columns(15).Alignment = dbgCenter
    .Columns(16).Alignment = dbgCenter
    .Columns(17).Alignment = dbgCenter
    .Columns(6).Button = True
    .Columns(15).Button = True
    
    Dim fmt As New StdDataFormat
    
        fmt.Format = "#,##,##0.00"
        Set .Columns(8).DataFormat = fmt
        Set .Columns(10).DataFormat = fmt
        Set .Columns(12).DataFormat = fmt
    Dim fmt1 As New StdDataFormat
    
        fmt1.Format = "#,##,##0"
        Set .Columns(14).DataFormat = fmt1
    
End With
End Sub
Private Sub SetMenuStatusAtError(Status As Boolean)
    mnuQuery = Status
    mnuActionSave = Status
    mnuRecordFirst = Status
    mnuRecordPrev = Status
    mnuRecordNext = Status
    mnuRecordLast = Status
    If Status = False Then
        iValidate = 0
    Else
        iValidate = 1
    End If
End Sub

'--------------------------Grid Functions----------------------------

Private Sub dg_flats_AfterColUpdate(ByVal ColIndex As Integer)
    bChange = True
    Call obj(0).GrdAfterColUpdate
    'Enable Menu When Error is corrected
    Call SetMenuStatusAtError(True)
End Sub

Private Sub dg_flats_BeforeUpdate(Cancel As Integer)
'Validation
    'Duplicate Rows
'    If Index = 0 Then
    If bChange = True And bDeleted(0) = False And badded(0) = True Then
        ReDim Preserve arrVal(1)
        arrVal(0) = "'" & dg_flats.Columns(7).Value & "'"
    If obj(0).UniqueInGrid("society_flats", "FLAT_NO", 1, arrVal()) = 0 Then
        '   arryas for primary key in the grids.(non repeating PK)
        Cancel = True
        MsgBox "Detail Record Already Present.", vbOKOnly, "Error"
        '   Disable Menu When Error
        Call SetMenuStatusAtError(False)
        End If
    End If
'    End If
 End Sub

Private Sub dg_flats_AfterDelete()
    bChange = True
    Dim i As Integer
'    Dim r As RecordStatusEnum
'    rsDetail(0).Move(r) = (1)
    rsDetail(0).MoveFirst
    For i = 0 To rsDetail(0).RecordCount
        dg_flats.Columns(2) = dg_flats.Row + 1
    Next
    Call obj(0).GrdAfterDelete
End Sub
Private Sub dg_flats_AfterUpdate()
    Call obj(0).GrdAfterUpdate
    iRecCount(0) = rsDetail(0).RecordCount
End Sub
Private Sub dg_flats_OnAddNew()

    dg_flats.Columns(0) = txt_soc_no.Text
    dg_flats.Columns(1) = Date
    dg_flats.Columns(2) = dg_flats.Row + 1
'    dg_flats.Columns(2) = iSrno
    badded(0) = True
    bFirstEdit = True
    dg_flats.Columns(1) = txt_date.Text
'    txt_date.Text = Format("dd-MMM-yyyy")
'    txtEntryBy.Text = sUserName
'    txtApproved.Text = sUserName
    badded(0) = True

End Sub
Private Sub dg_flats_AfterInsert()
   Call obj(0).GrdRowColChange
   If iRecCount(0) < rsDetail(0).RecordCount Then
        mnuRecordDelete.Enabled = False
        badded(0) = True
    Else
        mnuRecordDelete.Enabled = True
        badded(0) = False
        Call SetDetails(0)
    End If
    bDetailFocous(0) = True
End Sub

Private Sub dg_flats_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   Call obj(0).GrdRowColChange
   If iRecCount(0) < rsDetail(0).RecordCount Then
        mnuRecordDelete.Enabled = False
        badded(0) = True
    Else
        mnuRecordDelete.Enabled = True
        badded(0) = False
        Call SetDetails(0)
    End If
    bDetailFocous(0) = True
End Sub
Private Sub dg_flats_LostFocus()
    bApproveFocous(0) = bDetailFocous(0)
    bDetailFocous(0) = False
End Sub
'Master Controls Code
Private Sub SetDateToForm()
If rsMaster.RecordCount > 0 Then
    txt_date = rsMaster.Fields("DATE_TODAY")
    txt_date = Format(rsMaster.Fields("DATE_TODAY"), "dd-MMM-yyyy")
Else
    txt_date = Format(Date, "dd-MMM-yyyy")
End If
End Sub
'Master Controls Code Over
'-------------------------------------------------------------------
'------------------menu Functions-----------------
Private Sub mnuActionCancel_Click()
    Dim itr As Integer
    bChange = False
    iValidate = 1
'    g_CnnDb.RollbackTrans
    If bExit = False Then
        g_CnnDb.BeginTrans
    Else
        'disable All Detail Focous Variables
        For itr = 0 To iNoOfDetails - 1
            bDetailFocous(itr) = False
        Next
        Exit Sub
    End If
    If bMasterAdd = True Then
        'Show Last Record
        Call ShowLastRecord
    Else
        Call LoadMaster
        If rsDetail(0).RecordCount = 0 Then
            rsMaster.MoveLast
            txt_soc_no = rsMaster.Fields(0)
            
        End If
        Call SearchRecord(rsMaster, 1, 0, txt_soc_no, 1)
        Call SetMaster
        For itr = 0 To iNoOfDetails - 1
            Call LoadDetails(itr)
            Call obj(0).RearrangeSrNo(1)
            'disable All Detail Focous Variables
            bDetailFocous(itr) = False
        Next
        Call SetDateToForm
    End If
    Call StartUpMenu 'Show Start Up Menu
    bChange = False
    bMasterAdd = False
End Sub

Private Sub mnuRecordAdd_Click()
    Call ResetControls
    bMasterAdd = True
    mnuQuery = False
    mnuRecord = False
    mnuActionSave = True
    mnuActionCancel = True
    mnuActionExit = False
'    Dim itr As Integer
'    For itr = 0 To iNoOfDetails - 1
'        dg_flats(0).Enabled = True
'    Next
    'Enable Primary Key Controls
End Sub

Private Sub mnuActionExit_Click()
    Unload Me
End Sub

Private Sub mnuRecordDelete_Click()
Dim itr As Integer
        If Not rsMaster.BOF And Not rsMaster.EOF Then
            'Check If All Child Records Are present
            If iRecCount(0) = 0 Then
                Dim iResponse As VbMsgBoxResult
                iResponse = MsgBox("Do you Really want to Delete this Record", vbYesNo)
                DoEvents
                If iResponse = vbYes Then
                    rsMaster.Requery
                    Call SearchRecord(rsMaster, 1, 0, txt_soc_no, 1)
                    rsMaster.Delete
                    rsMaster.Update
                    If rsMaster.RecordCount > 0 Then
                        rsMaster.MoveNext
                        If rsMaster.EOF Then rsMaster.MovePrevious
                    End If
                    If rsMaster.RecordCount = 0 Then
                        Call StartUpMenu
                        mnuActionSave = True
                        mnuActionCancel = True
                    End If
                    Call SetMaster
                    For itr = 0 To iNoOfDetails - 1
                        Call LoadDetails(itr)
                    Next
                    bChange = True
                End If
            End If
        End If
        For itr = 0 To iNoOfDetails - 1
            If rsDetail(0).RecordCount = 0 Then bDetailFocous(itr) = False
        Next
    If bDetailFocous(0) = True Then 'Delete Detail Record
        DeleteDetailRecord (0)
    End If
End Sub
Private Function DeleteDetailRecord(DetailNo As Integer)
    Dim iResponse As VbMsgBoxResult
    bDeleted(DetailNo) = True
    Call obj(0).mnuRecordDelete
    If rsDetail(0).EOF Then rsDetail(0).MovePrevious
    DoEvents
    If rsDetail(0).BOF = True And rsDetail(0).EOF = False Then
        ' Prompt user to commit all changes made
        DoEvents
        iResponse = MsgBox("Save Previous Deletions?", vbYesNo)
        If iResponse = vbYes Then
            mnuActionSave_Click
        Else
            g_CnnDb.RollbackTrans
            g_CnnDb.BeginTrans
            Set rsDetail(0) = Nothing
            Set rsDetail(0) = New ADODB.Recordset
            Call LoadDetails(DetailNo)
            Call obj(0).RearrangeSrNo(1)
            'disable All Detail Focous Variables
            bDetailFocous(DetailNo) = False
        End If
    End If
    bDeleted(DetailNo) = False
End Function
Private Sub mnuQueryEnter_Click()
    Dim bTemp, bTemp1 As Boolean
    bTemp = bMChange 'Save Status of bMchange variable
    bTemp1 = bChange 'Save Status of bchange variable
    bQEnter = True
    Call ResetControls
    Dim itr As Integer
    For itr = 0 To iNoOfDetails - 1
        dg_flats(itr).Enabled = False
    Next
    bMChange = bTemp 'Reset Status of bMchange variable as it was at start of function
    bChange = bTemp1  'Reset Status of bchange variable as it was at start of function
    mnuRecord.Enabled = False
    mnuAction.Enabled = False
    mnuQueryEnter.Enabled = False
    mnuQueryCancel.Enabled = True
    'Enable Primary Key Controls
    
End Sub
Private Sub mnuQueryCancel_Click()
    Call ShowLastRecord
    Call StartUpMenu
    bQEnter = False
End Sub

Private Sub mnuActionSave_Click()
'------------------------------------------------------------
'On Error GoTo ErrorHandler
    Dim itr As Integer
    bChange = False
    'Update Temp Master
    If bMChange = True Then _
'        Call SaveTempMaster
    'Validation
        If DoValidation() = 1 Then
            'Update Foreign key in Temp Detail Table as per Master
            For itr = 0 To iNoOfDetails - 1
            If rsDetail(0).RecordCount > 0 Then
                If rsDetail(0).EOF = True Then rsDetail(0).MoveLast
                rsDetail(0).Update
                rsDetail(0).MoveFirst
                While Not rsDetail(0).EOF
                    rsDetail(0).Fields("SOCIETY_NO") = txt_soc_no
                    rsDetail(0).Update
                    rsDetail(0).MoveNext
                Wend
                rsDetail(0).MoveLast
            End If
            Next
            'Update Temp Master
            If bMChange = True Then _
    '            Call SaveTempMaster
            'Changes In temp detail to be updated
                For itr = 0 To iNoOfDetails - 1
                If rsDetail(0).RecordCount > 0 Then
                    rsDetail(0).Update
                End If
                Next
            End If
            g_CnnDb.CommitTrans
            If bExit = False Then g_CnnDb.BeginTrans
            'disable Primary Key Fields
        Else
            bExit = False
            'disable All Detail Focous Variables
            For itr = 0 To iNoOfDetails - 1
                bDetailFocous(itr) = False
            Next
            Exit Sub
        End If
    End If
    bMasterAdd = False
    Call StartUpMenu
    'For Serial No
    For itr = 0 To iNoOfDetails - 1
    If rsDetail(0).RecordCount > 0 Then rsDetail(0).MoveLast
        If rsDetail(0).BOF And Not rsDetail(0).EOF Then
            obj(0).SetSrno ' Set srno to 1
            Exit Sub
        End If
    Call obj(0).RearrangeSrNo(1)
    'disable All Detail Focous Variables
    bDetailFocous(itr) = False
    Next
    'Exit Sub
'ErrorHandler:
'    MsgBox "Atul"
'    If Err.Number = -2147467259 Then
'        MsgBox ""
'        Exit Sub
'    End If
'
End Sub
'---------------------------------------------------------------------
Private Function DoValidation() As Integer
    iValidate = 1
    'When in Add Mode Don't Perform Validations
    If bMasterAdd = True And bExit = True Then
        DoValidation = iValidate 'True
        Exit Function
    End If
    'When in Enter Query Mode Don't Perform Validations
    If bQEnter = True Then
        DoValidation = iValidate 'True
        Exit Function
    End If
    If rsMaster.RecordCount = 0 Then
        DoValidation = iValidate 'True
        Exit Function
    End If
    'Validation started
    'Master Validation
    Dim arrVal() As Variant
    ReDim Preserve arrVal(3)
    arrVal(0) = "'" & txt_soc_no & "'"
'    If objMaster.Unique(sTmpMaster, "PRODUCT_NO,STAGE_NO,PROD_DRAWING_NO", 3, arrVal()) = 0 And bMasterAdd = True Then
'        MsgBox "Master Record Already Present.", vbOKOnly, "Error"
'        txtPrdtName.SetFocus
'        iValidate = 0
'        DoValidation = iValidate
'        Exit Function
'    End If
        'Detail Validation
    'Validations
    Dim bNull As Boolean
    If rsDetail(0).RecordCount > 0 Then
        rsDetail(0).MoveFirst
        While rsDetail(0).EOF <> True
            bNull = True
            For i = 1 To rsDetail(0).Fields.Count - 4
                If Not IsNull(rsDetail(0).Fields(i)) Then
                    bNull = False
                End If
            Next
            If bNull = True Then
                rsDetail(0).Delete
                rsDetail(0).Update
            End If
            'Validation For Checking if primary Keys Are Filled
            If IsNull(rsDetail(0).Fields("SOCIETY_NO")) = True Then
                MsgBox "Required Field Missing", vbExclamation, "Error"
                iValidate = 0
                DoValidation = iValidate
                Exit Function
            End If
            rsDetail(0).MoveNext
        Wend
    End If
    'Validations Over
    DoValidation = iValidate 'True
End Function
'ToolBar Functions
'Private Sub Toolbar1_Buttonclick(ByVal Button As MSComctlLib.Button)
'    Dim itr As Integer
'    Dim bTemp, bTemp1 As Boolean
'    If bMasterAdd = True Then Exit Sub
'    bTemp = bMChange 'Save Status of bMchange variable
'    bTemp1 = bChange 'Save Status of bchange variable
'    Select Case Button.Index
'    Case 3 'First
'        If Not rsMaster.BOF And Not rsMaster.EOF Then
'            rsMaster.MoveFirst
'            Call SetMaster
'            For itr = 0 To iNoOfDetails - 1
'                Call LoadDetails(itr)
'            Next
'            Call SetDateToForm
'        End If
'    Case 4 'Previous
'        If rsMaster.BOF And rsMaster.EOF Then
'            Exit Sub
'        Else
'            rsMaster.MovePrevious
'        End If
'        If rsMaster.BOF Then
'            rsMaster.MoveFirst
'        End If
'        Call SetMaster
'        For itr = 0 To iNoOfDetails - 1
'            Call LoadDetails(itr)
'        Next
'        Call SetDateToForm
'    Case 5 'Next
'        If rsMaster.BOF And rsMaster.EOF Then
'            Exit Sub
'        Else
'            rsMaster.MoveNext
'        End If
'        If rsMaster.EOF Then
'            rsMaster.MoveLast
'        End If
'        Call SetMaster
'        For itr = 0 To iNoOfDetails - 1
'            Call LoadDetails(itr)
'        Next
'        Call SetDateToForm
'    Case 6 'Last
'        If Not rsMaster.BOF And Not rsMaster.EOF Then
'            rsMaster.MoveLast
'            Call SetMaster
'            For itr = 0 To iNoOfDetails - 1
'                Call LoadDetails(itr)
'            Next
'            Call SetDateToForm
'        End If
'    End Select
'    bMChange = bTemp 'Reset Status of bMchange variable as it was at start of function
'    bChange = bTemp1  'Reset Status of bchange variable as it was at start of function
'    bQEnter = False
'    Call StartUpMenu
'End Sub

Private Sub mnuRecordFirst_Click()
Dim bTemp, bTemp1 As Boolean
bTemp = bMChange 'Save Status of bMchange variable
bTemp1 = bChange 'Save Status of bchange variable
    If Not rsMaster.BOF And Not rsMaster.EOF Then
        rsMaster.MoveFirst
        Call SetMaster
        For itr = 0 To iNoOfDetails - 1
            Call LoadDetails(itr)
        Next
        Call SetDateToForm
    End If
bMChange = bTemp 'Reset Status of bMchange variable as it was at start of function
bChange = bTemp1  'Reset Status of bchange variable as it was at start of function
End Sub

Private Sub mnuRecordLast_Click()
Dim bTemp, bTemp1 As Boolean
bTemp = bMChange 'Save Status of bMchange variable
bTemp1 = bChange 'Save Status of bchange variable
    If Not rsMaster.BOF And Not rsMaster.EOF Then
        rsMaster.MoveLast
        Call SetMaster
        For itr = 0 To iNoOfDetails - 1
            Call LoadDetails(itr)
        Next
        Call SetDateToForm
    End If
bMChange = bTemp 'Reset Status of bMchange variable as it was at start of function
bChange = bTemp1  'Reset Status of bchange variable as it was at start of function
End Sub

Private Sub mnuRecordNext_Click()
Dim bTemp, bTemp1 As Boolean
bTemp = bMChange 'Save Status of bMchange variable
bTemp1 = bChange 'Save Status of bchange variable
    If rsMaster.BOF And rsMaster.EOF Then
        Exit Sub
    Else
        rsMaster.MoveNext
    End If
    If rsMaster.EOF Then
        rsMaster.MoveLast
    End If
    Call SetMaster
    For itr = 0 To iNoOfDetails - 1
        Call LoadDetails(itr)
    Next
    Call SetDateToForm
    bMChange = bTemp 'Reset Status of bMchange variable as it was at start of function
    bChange = bTemp1  'Reset Status of bchange variable as it was at start of function
End Sub

Private Sub mnuRecordPrev_Click()
Dim bTemp, bTemp1 As Boolean
bTemp = bMChange 'Save Status of bMchange variable
bTemp1 = bChange 'Save Status of bchange variable
    If rsMaster.BOF And rsMaster.EOF Then
        Exit Sub
    Else
        rsMaster.MovePrevious
    End If
    If rsMaster.BOF Then
        rsMaster.MoveFirst
    End If
    Call SetMaster
    For itr = 0 To iNoOfDetails - 1
        Call LoadDetails(itr)
    Next
    Call SetDateToForm
    bMChange = bTemp 'Reset Status of bMchange variable as it was at start of function
    bChange = bTemp1  'Reset Status of bchange variable as it was at start of function
End Sub


frm_MDI
Option Explicit
Private Sub mnu_soc_Click()
disable_menu Me
frm_Society.Show
End Sub


Module Global
Option Explicit
Public g_CnnDb As ADODB.Connection
Public gblsForm As String 'Stores Form Name
'///////////////Registry//////////////////////
Public gblDatabase As String 'Stores Database Name from Reg
Public gblDBAUser As String 'Stores DBA USer Name from Reg
Public gblTableSpace As String 'Stores TableSpace Name from Reg
Public gblDsn As String 'Stores DSN Name from Reg
Public gblLastForm As String 'Stores Form Name which was opened Last time from Reg
'//////////////////////////////////////
Public bConected As Boolean
Dim strSql As String
'Status Bar Panel Index Variables
Public SSBARHELP As Integer
Public LOVKEY As Integer
Public Function InitializeGlobalVariables()
SSBARHELP = 1 'For Showing Help on Status Bar
LOVKEY = 120 'Key used To Get List Of Values '120 for f9
gblsForm = ""
Call GetRegistryValues
If gblTableSpace = "" Or gblDBAUser = "" Or gblDsn = "" Or gblDatabase = "" Then
    MsgBox "Settings Not Available.Run Setup Again."
    End
Else
    Call CreateDSN(gblDsn, gblDatabase)
End If
End Function
'dATADASE fUNCTIONS
Public Function ExecuteSqlSmt(ByVal Statement As String)
On Error GoTo ErrorHandler:
    g_CnnDb.Execute Statement
    Exit Function
ErrorHandler:
    MsgBox Err.Description
    Exit Function
End Function
'Public Function GetAllRecords(ByRef rs As ADODB.Recordset, ByVal strqry As String)
'On Error GoTo ErrorHandler
'    rs.Open strqry, g_CnnDb, adOpenDynamic, adLockOptimistic
'        Exit Function
'ErrorHandler:
'    MsgBox Err.Description
'    Exit Function
'End Function
Public Function GetAllRecords(ByRef rs As ADODB.Recordset, ByVal strqry As String)
Dim cnn1 As New Connection
'Dim rs As Recordset
'    cnn1.Mode = adModeRead
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\Hsg Soc.mdb;"
    Set rs = New ADODB.Recordset
    On Error GoTo ErrorHandler
'    rs.Open "TMP_SOCIETY", cnn1, adOpenDynamic, _
        adLockOptimistic
    rs.Open strqry, cnn1, adOpenDynamic, adLockOptimistic
'    On Error GoTo ErrorHandler
'    rs.Open strqry, g_cnndb, adOpenDynamic, adLockOptimistic
        Exit Function
ErrorHandler:
    MsgBox Err.Description
    Exit Function
End Function
Public Function FillListCtrl(ByRef lst As ListBox, strqry As String)
On Error GoTo ErrorHandler
    Dim rs As New ADODB.Recordset
    rs.Open strqry, g_CnnDb, adOpenDynamic, adLockOptimistic
    lst.Clear
    While Not rs.EOF
        lst.AddItem (rs.Fields(0).Value)
        rs.MoveNext
    Wend
    Set rs = Nothing
    Exit Function
ErrorHandler:
    Set rs = Nothing
    MsgBox Err.Description
    Exit Function
End Function
Public Function FillComboCtrl(ByRef lst As ComboBox, strqry As String)
On Error GoTo ErrorHandler
    Dim rs As New ADODB.Recordset
    rs.Open strqry, g_CnnDb, adOpenDynamic, adLockOptimistic
    lst.Clear
    While Not rs.EOF
        lst.AddItem (rs.Fields(0).Value)
        rs.MoveNext
    Wend
    Set rs = Nothing
    Exit Function
ErrorHandler:
    Set rs = Nothing
    MsgBox Err.Description
    Exit Function
End Function
Public Function SearchRecord(ByRef rs As ADODB.Recordset, NoOfSearch As Integer, Index1 As Integer, Para1 As Variant, Optional Index2 As Integer, Optional Para2 As Variant, Optional Index3 As Integer, Optional Para3 As Variant, Optional Index4 As Integer, Optional Para4 As Variant, Optional Index5 As Integer, Optional Para5 As Variant) As Integer
    rs.MoveFirst
    Dim bFind As Boolean
    bFind = False
    SearchRecord = 0
    If NoOfSearch = 1 Then
        While Not rs.EOF And Not bFind
            If (rs.Fields(Index1).Value = Para1) Then
                bFind = True
                SearchRecord = 1
            Else
                rs.MoveNext
            End If
        Wend
    End If
    If NoOfSearch = 2 Then
        While Not rs.EOF And Not bFind
            If (rs.Fields(Index1).Value = Para1) Then
                If (rs.Fields(Index2).Value = Para2) Then
                    bFind = True
                    SearchRecord = 1
                Else
                    rs.MoveNext
                End If
            Else
                rs.MoveNext
            End If
        Wend
    End If
    If NoOfSearch = 3 Then
        While Not rs.EOF And Not bFind
            If (rs.Fields(Index1).Value = Para1) Then
                If (rs.Fields(Index2).Value = Para2) Then
                    If (rs.Fields(Index3).Value = Para3) Then
                        bFind = True
                        SearchRecord = 1
                    Else
                        rs.MoveNext
                    End If
                Else
                    rs.MoveNext
                End If
            Else
                rs.MoveNext
            End If
        Wend
    End If
    If NoOfSearch = 4 Then
        While Not rs.EOF And Not bFind
            If (rs.Fields(Index1).Value = Para1) Then
                If (rs.Fields(Index2).Value = Para2) Then
                    If (rs.Fields(Index3).Value = Para3) Then
                        If (rs.Fields(Index4).Value = Para4) Then
                            bFind = True
                            SearchRecord = 1
                        Else
                            rs.MoveNext
                        End If
                    Else
                        rs.MoveNext
                    End If
                Else
                    rs.MoveNext
                End If
            Else
                rs.MoveNext
            End If
        Wend
    End If
    If NoOfSearch = 5 Then
        While Not rs.EOF And Not bFind
            If (rs.Fields(Index1).Value = Para1) Then
                If (rs.Fields(Index2).Value = Para2) Then
                    If (rs.Fields(Index3).Value = Para3) Then
                        If (rs.Fields(Index4).Value = Para4) Then
                            If (rs.Fields(Index4).Value = Para4) Then
                                bFind = True
                                SearchRecord = 1
                            Else
                                rs.MoveNext
                            End If
                        Else
                            rs.MoveNext
                        End If
                    Else
                        rs.MoveNext
                    End If
                Else
                    rs.MoveNext
                End If
            Else
                rs.MoveNext
            End If
        Wend
    End If
End Function
Public Function GetMaxId(ColName As String, TableName As String) As Variant
    Dim rs As New ADODB.Recordset
    strSql = "SELECT MAX(to_number(" & ColName & ")) FROM " & TableName
    GetAllRecords rs, strSql
    If IsNull(rs.Fields(0)) Then
        GetMaxId = 0
    Else
        GetMaxId = rs.Fields(0)
    End If
    Set rs = Nothing
End Function
'dATABASE fUNCTIONSOVER



Module Utility Functions

Option Explicit
Public Function figtoword(figure As Variant) As String
    Dim PS, HUN, THOU, LAC, CRORE, CRORE100, CRORE1000 As Variant
    Dim amt As String, word As String
    Dim lth As Long
    ' amt = Format(figure, "#.##") return "." to str() incase of 0
    ' resulting data type mismatch error.
    
    If Trim(figure) = "0" Or Trim(figure) = "" Then
       figtoword = "Rupees Zero"
       Exit Function
    End If

    amt = Trim(str(figure))
    
    If InStr(1, amt, ".") = 0 Then
           amt = amt + ".00"
    End If
    
    amt = Space(20 - Len(amt)) + amt
    
    If Mid(amt, Len(amt) - 2, 1) <> "." Then
           amt = amt + "0"
    End If
    
    word = "Rupees"
    lth = Len(word)
    
    PS = Mid$(amt, Len(amt) - 1, 2)
    HUN = Mid$(amt, Len(amt) - 5, 3)
    THOU = Mid$(amt, Len(amt) - 7, 2)
    LAC = Mid$(amt, Len(amt) - 9, 2)
    CRORE = Mid$(amt, Len(amt) - 11, 2)
    CRORE100 = Mid$(amt, Len(amt) - 13, 2)
    CRORE1000 = Mid$(amt, Len(amt) - 15, 2)
    If Trim(CRORE1000) <> "" Then
        word = word + readFigure(CRORE1000)
        If lth <> Len(word) Then
           word = word + " Thousand Crores"
        End If
        lth = Len(word)
    End If
    If Trim(CRORE100) <> "" Then
        word = readFigure(CRORE100)
        If lth <> Len(word) Then
           word = word + " Hundred Crores"
        End If
        lth = Len(word)
    End If
    If Trim(CRORE) <> "" Then
        word = word + readFigure(CRORE)
        If lth <> Len(word) Then
           word = word + " Crore"
        End If
        lth = Len(word)
    End If
    If Trim(LAC) <> "" Then
        word = word + readFigure(LAC)
        If lth <> Len(word) Then
           word = word + " Lac"
        End If
        lth = Len(word)
    End If
    If Trim(THOU) <> "" Then
        word = word + readFigure(THOU)
        If lth <> Len(word) Then
           word = word + " Thousand"
        End If
        lth = Len(word)
    End If
    word = word + readFigure("0" + Left(HUN, 1))
    If lth <> Len(word) Then
       word = word + " Hundred"
    End If
    lth = Len(word)
    
    word = word + readFigure(Right(HUN, 2))
    If PS <> "00" Then
       If Len(Trim(HUN)) <> 0 Then
          word = word + " and"
       End If
    End If
    lth = Len(word)
    If PS = "00" Then
        word = word + " Only"
    Else
        word = word + readFigure(PS)
        word = word + " Paise Only"
    End If
    
    figtoword = word

End Function
Private Function readFigure(ByVal Amount As String) As String
    Dim word As String
    If Left(Amount, 1) = "1" Then
        Select Case Right(Amount, 1)
            Case Is = "0"
                word = word + " Ten"
            Case Is = "1"
                word = word + " Eleven"
            Case Is = "2"
                word = word + " Twelve"
            Case Is = "3"
                word = word + " Thirteen"
            Case Is = "4"
                word = word + " Fourteen"
            Case Is = "5"
                word = word + " Fifteen"
            Case Is = "6"
                word = word + " Sixteen"
            Case Is = "7"
                word = word + " Seventeen"
            Case Is = "8"
                word = word + " Eighteen"
            Case Is = "9"
                word = word + " Nineteen"
        End Select
    Else
        Select Case Left(Amount, 1)
            Case Is = "2"
                word = word + " Twenty"
            Case Is = "3"
                word = word + " Thirty"
            Case Is = "4"
                word = word + " Fourty"
            Case Is = "5"
                word = word + " Fifty"
            Case Is = "6"
                word = word + " Sixty"
            Case Is = "7"
                word = word + " Seventy"
            Case Is = "8"
                word = word + " Eighty"
            Case Is = "9"
                word = word + " Ninety"
    End Select
        
        Select Case Right(Amount, 1)
            Case "1"
                word = word + " One"
            Case "2"
                word = word + " Two"
            Case "3"
                word = word + " Three"
            Case "4"
                word = word + " Four"
            Case "5"
                word = word + " Five"
            Case "6"
                word = word + " Six"
            Case "7"
                word = word + " Seven"
            Case "8"
                word = word + " Eight"
            Case "9"
                word = word + " Nine"
         End Select
    End If
    readFigure = word
End Function
Public Function GetDaysOfMonth(ByVal vDate) As Integer
    Dim sYear As String
    Dim stemp As String
    stemp = Format(Date, "mmm")
    sYear = Format(vDate, "yyyy")
    Select Case stemp
        Case "Jan", "Mar", "May", "Jul", "Aug", "Oct", "Dec"
            GetDaysOfMonth = 31
        Case "Feb"
            If CInt(sYear) / 4 = 0 Then
                GetDaysOfMonth = 29
            Else
                GetDaysOfMonth = 28
            End If
            
        Case "Apr", "Jun", "Sep", "Nov"
            GetDaysOfMonth = 30
    End Select
End Function
Public Function FillArray(ByRef arrCol() As String, ByVal sList)
'Give Count of Strings in , Seperated String
    Dim stemp As String
    Dim MyPos, iCount As Integer
    stemp = sList
    iCount = 0
    MyPos = -1
    While MyPos <> 0
        MyPos = InStr(stemp, ",")
        stemp = Right(stemp, Len(stemp) - MyPos)
        iCount = iCount + 1
    Wend
    stemp = sList
    iCount = 0
    MyPos = -1
    While MyPos <> 0
        ReDim Preserve arrCol(iCount)
        MyPos = InStr(stemp, ",")
        If MyPos = 0 Then
            arrCol(iCount) = stemp
        Else
            arrCol(iCount) = Left(stemp, MyPos - 1)
        End If
        stemp = Right(stemp, Len(stemp) - MyPos)
        iCount = iCount + 1
    Wend
End Function
'Validations Function
'Public Function CheckNumeric(ByRef KeyAscii As Integer, ByRef SSBar As StatusBar)
'Select Case KeyAscii
'Case Asc("0") To Asc("9"), Asc(".")
'    SSBar.Panels(SSBARHELP) = ""
'Case 30 To 47, 58 To 126
'    SSBar.Panels(SSBARHELP) = "Enter Numeric Value <0 - 9>"
'    KeyAscii = 0
'End Select
'End Function

Module clsGrid Functions
Option Explicit
Public Function figtoword(figure As Variant) As String
    Dim PS, HUN, THOU, LAC, CRORE, CRORE100, CRORE1000 As Variant
    Dim amt As String, word As String
    Dim lth As Long
    ' amt = Format(figure, "#.##") return "." to str() incase of 0
    ' resulting data type mismatch error.
    
    If Trim(figure) = "0" Or Trim(figure) = "" Then
       figtoword = "Rupees Zero"
       Exit Function
    End If

    amt = Trim(str(figure))
    
    If InStr(1, amt, ".") = 0 Then
           amt = amt + ".00"
    End If
    
    amt = Space(20 - Len(amt)) + amt
    
    If Mid(amt, Len(amt) - 2, 1) <> "." Then
           amt = amt + "0"
    End If
    
    word = "Rupees"
    lth = Len(word)
    
    PS = Mid$(amt, Len(amt) - 1, 2)
    HUN = Mid$(amt, Len(amt) - 5, 3)
    THOU = Mid$(amt, Len(amt) - 7, 2)
    LAC = Mid$(amt, Len(amt) - 9, 2)
    CRORE = Mid$(amt, Len(amt) - 11, 2)
    CRORE100 = Mid$(amt, Len(amt) - 13, 2)
    CRORE1000 = Mid$(amt, Len(amt) - 15, 2)
    If Trim(CRORE1000) <> "" Then
        word = word + readFigure(CRORE1000)
        If lth <> Len(word) Then
           word = word + " Thousand Crores"
        End If
        lth = Len(word)
    End If
    If Trim(CRORE100) <> "" Then
        word = readFigure(CRORE100)
        If lth <> Len(word) Then
           word = word + " Hundred Crores"
        End If
        lth = Len(word)
    End If
    If Trim(CRORE) <> "" Then
        word = word + readFigure(CRORE)
        If lth <> Len(word) Then
           word = word + " Crore"
        End If
        lth = Len(word)
    End If
    If Trim(LAC) <> "" Then
        word = word + readFigure(LAC)
        If lth <> Len(word) Then
           word = word + " Lac"
        End If
        lth = Len(word)
    End If
    If Trim(THOU) <> "" Then
        word = word + readFigure(THOU)
        If lth <> Len(word) Then
           word = word + " Thousand"
        End If
        lth = Len(word)
    End If
    word = word + readFigure("0" + Left(HUN, 1))
    If lth <> Len(word) Then
       word = word + " Hundred"
    End If
    lth = Len(word)
    
    word = word + readFigure(Right(HUN, 2))
    If PS <> "00" Then
       If Len(Trim(HUN)) <> 0 Then
          word = word + " and"
       End If
    End If
    lth = Len(word)
    If PS = "00" Then
        word = word + " Only"
    Else
        word = word + readFigure(PS)
        word = word + " Paise Only"
    End If
    
    figtoword = word

End Function
Private Function readFigure(ByVal Amount As String) As String
    Dim word As String
    If Left(Amount, 1) = "1" Then
        Select Case Right(Amount, 1)
            Case Is = "0"
                word = word + " Ten"
            Case Is = "1"
                word = word + " Eleven"
            Case Is = "2"
                word = word + " Twelve"
            Case Is = "3"
                word = word + " Thirteen"
            Case Is = "4"
                word = word + " Fourteen"
            Case Is = "5"
                word = word + " Fifteen"
            Case Is = "6"
                word = word + " Sixteen"
            Case Is = "7"
                word = word + " Seventeen"
            Case Is = "8"
                word = word + " Eighteen"
            Case Is = "9"
                word = word + " Nineteen"
        End Select
    Else
        Select Case Left(Amount, 1)
            Case Is = "2"
                word = word + " Twenty"
            Case Is = "3"
                word = word + " Thirty"
            Case Is = "4"
                word = word + " Fourty"
            Case Is = "5"
                word = word + " Fifty"
            Case Is = "6"
                word = word + " Sixty"
            Case Is = "7"
                word = word + " Seventy"
            Case Is = "8"
                word = word + " Eighty"
            Case Is = "9"
                word = word + " Ninety"
    End Select
        
        Select Case Right(Amount, 1)
            Case "1"
                word = word + " One"
            Case "2"
                word = word + " Two"
            Case "3"
                word = word + " Three"
            Case "4"
                word = word + " Four"
            Case "5"
                word = word + " Five"
            Case "6"
                word = word + " Six"
            Case "7"
                word = word + " Seven"
            Case "8"
                word = word + " Eight"
            Case "9"
                word = word + " Nine"
         End Select
    End If
    readFigure = word
End Function
Public Function GetDaysOfMonth(ByVal vDate) As Integer
    Dim sYear As String
    Dim stemp As String
    stemp = Format(Date, "mmm")
    sYear = Format(vDate, "yyyy")
    Select Case stemp
        Case "Jan", "Mar", "May", "Jul", "Aug", "Oct", "Dec"
            GetDaysOfMonth = 31
        Case "Feb"
            If CInt(sYear) / 4 = 0 Then
                GetDaysOfMonth = 29
            Else
                GetDaysOfMonth = 28
            End If
            
        Case "Apr", "Jun", "Sep", "Nov"
            GetDaysOfMonth = 30
    End Select
End Function
Public Function FillArray(ByRef arrCol() As String, ByVal sList)
'Give Count of Strings in , Seperated String
    Dim stemp As String
    Dim MyPos, iCount As Integer
    stemp = sList
    iCount = 0
    MyPos = -1
    While MyPos <> 0
        MyPos = InStr(stemp, ",")
        stemp = Right(stemp, Len(stemp) - MyPos)
        iCount = iCount + 1
    Wend
    stemp = sList
    iCount = 0
    MyPos = -1
    While MyPos <> 0
        ReDim Preserve arrCol(iCount)
        MyPos = InStr(stemp, ",")
        If MyPos = 0 Then
            arrCol(iCount) = stemp
        Else
            arrCol(iCount) = Left(stemp, MyPos - 1)
        End If
        stemp = Right(stemp, Len(stemp) - MyPos)
        iCount = iCount + 1
    Wend
End Function
'Validations Function
'Public Function CheckNumeric(ByRef KeyAscii As Integer, ByRef SSBar As StatusBar)
'Select Case KeyAscii
'Case Asc("0") To Asc("9"), Asc(".")
'    SSBar.Panels(SSBARHELP) = ""
'Case 30 To 47, 58 To 126
'    SSBar.Panels(SSBARHELP) = "Enter Numeric Value <0 - 9>"
'    KeyAscii = 0
'End Select
'End Function

Class Module clsGrid Functions

Option Explicit
Dim iSrno As Integer
Dim bDeleted As Boolean
Dim badded As Boolean
Dim bColEdit As Boolean
Dim bFirstEdit As Boolean
Dim iRecCount As Integer
Dim iDelRec As Integer
'
Dim m_TableName As String
Dim m_ColName1 As String
Dim m_ColName2 As String
Dim m_ColName3 As String
Dim m_ColName4 As String
Dim m_ColName5 As String
Dim m_ColValue1 As Variant
Dim m_ColValue2 As Variant
Dim m_ColValue3 As Variant
Dim m_ColValue4 As Variant
Dim m_ColValue5 As Variant
Dim m_QueryString As String
Public rsDetail As ADODB.Recordset
Public grdDetail As DataGrid
Public Property Get ColName1() As String
    ColName1 = m_ColName1
End Property
Public Property Let ColName1(ByVal vNewValue As String)
    m_ColName1 = vNewValue
End Property
Public Property Get ColName3() As String
    ColName3 = m_ColName3
End Property
Public Property Let ColName3(ByVal vNewValue As String)
    m_ColName3 = vNewValue
End Property
Public Property Get ColName2() As String
    ColName2 = m_ColName2
End Property
Public Property Let ColName2(ByVal vNewValue As String)
    m_ColName2 = vNewValue
End Property
Public Property Get ColName4() As String
    ColName4 = m_ColName4
End Property
Public Property Let ColName4(ByVal vNewValue As String)
    m_ColName4 = vNewValue
End Property
Public Property Get ColName5() As String
    ColName5 = m_ColName5
End Property
Public Property Let ColName5(ByVal vNewValue As String)
    m_ColName5 = vNewValue
End Property
Public Property Get ColValue1() As Variant
    ColValue1 = m_ColValue1
End Property
Public Property Let ColValue1(ByVal vNewValue As Variant)
    m_ColValue1 = vNewValue
End Property
Public Property Get ColValue2() As Variant
    ColValue2 = m_ColValue2
End Property
Public Property Let ColValue2(ByVal vNewValue As Variant)
    m_ColValue2 = vNewValue
End Property
Public Property Get ColValue3() As Variant
    ColValue3 = m_ColValue3
End Property
Public Property Let ColValue3(ByVal vNewValue As Variant)
    m_ColValue3 = vNewValue
End Property
Public Property Get ColValue4() As Variant
ColValue4 = m_ColValue4
End Property
Public Property Let ColValue4(ByVal vNewValue As Variant)
    m_ColValue4 = vNewValue
End Property
Public Property Get ColValue5() As Variant
ColValue5 = m_ColValue5
End Property
Public Property Let ColValue5(ByVal vNewValue As Variant)
m_ColValue5 = vNewValue
End Property
Public Property Get TableName() As Variant
TableName = m_TableName
End Property
Public Property Let TableName(ByVal vNewValue As Variant)
m_TableName = vNewValue
End Property
'-------------Database Releated Functions-----------------
Public Function InsertRecord(strInsertQry As String)
    g_CnnDb.Execute strInsertQry
End Function
Public Function CreateQuery(strSelectQry As String)
Dim qry As String
If ColValue1 <> "" Then
     qry = qry & " where to_char(" & ColName1 & ") like '" & ColValue1 & "%'"
End If
If ColValue2 <> "" Then
    If qry <> "" Then
        qry = qry & " and "
    Else
        qry = qry & " where "
    End If
    qry = qry & "to_char(" & ColName2 & ") like '" & ColValue2 & "%'"
End If
If ColValue3 <> "" Then
    If qry <> "" Then
        qry = qry & " and "
    Else
        qry = qry & " where "
    End If
    qry = qry & "to_char(" & ColName3 & ") like '" & ColValue3 & "%'"
End If
If ColValue4 <> "" Then
    If qry <> "" Then
        qry = qry & " and "
    Else
        qry = qry & " where "
    End If
    qry = qry & "to_char(" & ColName4 & ") like '" & ColValue4 & "%'"
End If
If ColValue5 <> "" Then
    If qry <> "" Then
        qry = qry & " and "
    Else
        qry = qry & " where "
    End If
    qry = qry & "to_char(" & ColName5 & ") like '" & ColValue5 & "%'"
End If
qry = strSelectQry & " " & TableName & qry
 
 m_QueryString = qry
End Function
Public Function ReadymadeQuery(ByVal str As String) As String
    m_QueryString = str
    ReadymadeQuery = m_QueryString
End Function
'This function should be used only to fill grid where serial no is there
Public Function ExecuteQuery(ByRef grd As DataGrid, ByRef rr As ADODB.Recordset)
    Dim cnn1 As New Connection
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=H:\Hsg Soc.mdb;"
    If rr.State = 1 Then rr.Close
    rr.Open m_QueryString, cnn1, adOpenDynamic, adLockOptimistic
    Set grd.DataSource = rr
    Set rsDetail = rr
    iRecCount = rsDetail.RecordCount
End Function
'this function is used to display lov
Public Function FillLov(ByRef grd As DataGrid, ByRef rr As ADODB.Recordset)
    If rr.State = 1 Then rr.Close
    rr.Open m_QueryString, g_CnnDb, adOpenDynamic, adLockOptimistic
    Set grd.DataSource = rr
End Function
Public Function unique(TableName As String, PkList As String, nPk As Integer, Value() As Variant) As Integer
    Dim s As String
    Dim rs As New ADODB.Recordset
    Dim arr() As String
    FillArray arr(), PkList
    s = "SELECT " & PkList & " FROM " & TableName & " WHERE "
    For X = 0 To nPk - 1
        s = s & arr(X) & "=" & Value(X) & " AND "
    Next
    s = Mid(s, 1, Len(s))
    Call GetAllRecords(rs, s)
    If rs.RecordCount > 1 Then
        unique = 0  'not Unique
    Else
        unique = 1  'Unique
    End If
End Function
Public Function CheckUnique(TableName As String, PkList As String, nPk As Integer) As String
    Dim s, d, strTemp As String
    Dim rs As New ADODB.Recordset
    Dim rs1 As New ADODB.Recordset
    Dim bDup As Boolean
    d = "SELECT FLAT_NO," & PkList & " FROM " & TableName
    s = "SELECT FLAT_NO," & PkList & " FROM " & TableName
    Call GetAllRecords(rs1, d)
    Call GetAllRecords(rs, s)
    If rs1.RecordCount > 0 Then rs1.MoveFirst
    While Not rs1.EOF
        If rs.RecordCount > 0 Then rs.MoveFirst
        While Not rs.EOF
            bDup = True
            For X = 0 To nPk - 1
                If rs1.Fields(X + 1) <> rs.Fields(X + 1) Then
                    bDup = False
                End If
            Next
            If bDup = True And rs1.Fields("SR_NO") <> rs.Fields("SR_NO") Then
                strTemp = rs.Fields("SR_NO") & " - " & rs1.Fields("SR_NO")
                CheckUnique = strTemp
                Exit Function
            End If
            rs.MoveNext
        Wend
        rs1.MoveNext
    Wend
    Set rs = Nothing
    Set rs1 = Nothing
    CheckUnique = strTemp  'not Unique
End Function
Public Function UniqueInGrid(TableName As String, PkList As String, nPk As Integer, Value() As Variant) As Integer
    Dim s As String
    Dim X As Integer
    Dim rs As New ADODB.Recordset
    Dim arr() As String
    FillArray arr(), PkList
    s = "SELECT " & PkList & " FROM " & TableName & " WHERE "
    For X = 0 To nPk - 1
        s = s & arr(X) & "=" & Value(X) & " AND "
    Next
    s = Mid(s, 1, Len(s))
    
    Call GetAllRecords(rs, s)
    s = s + ";"
    If rs.RecordCount > 0 Then
        UniqueInGrid = 0  'not Unique
    Else
        UniqueInGrid = 1  'Unique
    End If
End Function
'-------------Database Releated Functions-----------------
' Grid Events Functions-----------------------------------
Public Function GrdAfterColUpdate()
    If bColEdit Then bColEdit = True 'bColEdit=TRUE Coloumn Update,bColEdit=TRUE RowInsert
    badded = True
    If bColEdit And bFirstEdit Then
        iSrno = iSrno - 1    'When Only Column Update
        bFirstEdit = False   'This Block should be only first Column Update of each row
    End If
End Function
Public Function GrdAfterDelete()
    iSrno = iSrno - 1
End Function
Public Function GrdAfterUpdate()
    If badded Then
        iSrno = iSrno + 1
        badded = False
        bColEdit = True
    End If
    bFirstEdit = True
    iRecCount = rsDetail.RecordCount
End Function
Public Function GrdOnAddNew()
    grdDetail.Columns(0) = iSrno
    badded = True
    bFirstEdit = True
End Function
Public Function GrdRowColChange()
    If iRecCount < rsDetail.RecordCount Then
        bColEdit = False
    Else
        bColEdit = True
    End If
End Function
Public Function RearrangeSrNo(ByRef vSrno As Integer)
    Dim rr As ADODB.Recordset
    Dim cnn1 As New Connection
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\Hsg Soc.mdb;"
    Set rr = deSoc.rscmd_society_flats
'    If rr.State = 1 Then rr.Close
'    rr.Open m_QueryString, cnn1, adOpenDynamic, adLockOptimistic
    Set rsDetail = rr
    badded = True
    If vSrno = 0 Then Exit Function
    iSrno = vSrno
    If Not rsDetail.BOF And True Then
'    If Not rsDetail(0).BOF And Not bDeleted Then
        rsDetail.MoveFirst
    Else
        bDeleted = False
    End If
    While Not rsDetail.EOF
        grdDetail.Columns(0) = iSrno
        iSrno = iSrno + 1
        If rsDetail.EOF <> True Then
            rsDetail.MoveNext
            badded = True
            iSrno = iSrno - 1
        End If
    Wend
    iRecCount = rsDetail.RecordCount
End Function
Public Function SetGrdVar()
    badded = True
    bColEdit = True
    Call RearrangeSrNo(1)
End Function
Public Function mnuRecordDelete()

    DoEvents
    If rsDetail.BOF = True Or rsDetail.EOF = True Then Exit Function
    iDelRec = rsDetail.Fields(0).Value
    DoEvents
    On Error Resume Next
    rsDetail.Delete
    bDeleted = True
    If rsDetail.RecordCount = iDelRec - 1 Then
        Call RearrangeSrNo(iDelRec - 1)
    Else
        Call RearrangeSrNo(iDelRec)
    End If
    bDeleted = False

End Function
Public Function SetSrno()
    iSrno = 1
End Function

' Grid Events Functions-----------------------------------





Is This A Good Question/Topic? 0
  • +

Replies To: Entering autonumber in datagrid

#2 Ionut  Icon User is offline

  • D.I.C Lover
  • member icon

Reputation: 385
  • View blog
  • Posts: 1,057
  • Joined: 17-July 10

Re: Entering autonumber in datagrid

Posted 10 September 2010 - 02:59 PM

While Not rsDetail.EOF  
         grdDetail.Columns(0) = iSrno  
         iSrno = iSrno + 1  
         If rsDetail.EOF <> True Then  
             rsDetail.MoveNext  
             badded = True  
            iSrno = iSrno - 1  
         End If  
    end  


In your code, i don't see to change SrNo anywhere, you don't change recordset's values and then update it.
i = 0
While not rsDetail.EOF
     if rsDetail.Fields(0) > iSrno - 1 then 'I didn't understand with what value do you call RearrangeSrNo so I assume that will be the deleted number,
         rsDetail.Fields(0) = iSrno + i
         i = i + 1
     end if 
     rsDetail.MoveNext
loop

rsDetail.Update ' or rsDetail.UpdateBatch



NOTE! The above code is not tested, i wrote it to point out what is wrong in what you did.

A MORE IMPORTANT NOTE! Changing the primary key of a table is a bad idea/approach/design. A primary key uniquely identifies a record, so you should let it how it is. If it is an autonumber column, any change done by you from code will not apply

Ionut
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1