• Home
 · 
• Miscellaneous
 · 
• using MSFlexGrid Entering Data,editng data, removal of data

using MSFlexGrid Entering Data,editng data, removal of data

using MSFlexGrid Entering Data,editng data, removal of data

API Declarations


Dim rstX As New ADODB.Recordset
Dim rsttrans As New ADODB.Recordset
Dim rstValue As New ADODB.Recordset




Rate using MSFlexGrid Entering Data,editng data, removal of data

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Function DefaultFlexGrid()
    FG1.Cols = 7
    FG1.FixedCols = 1
    FG1.ColWidth(0) = 350
    FG1.ColWidth(1) = 500
    FG1.ColWidth(2) = 2000
    FG1.ColWidth(3) = 1200
    FG1.ColWidth(4) = 1100
    FG1.ColWidth(5) = 1750
    FG1.ColWidth(6) = 1400
    

    FG1.TextMatrix(0, 0) = ""
    FG1.TextMatrix(0, 1) = "S.No"
    FG1.TextMatrix(0, 2) = "Item"
    FG1.TextMatrix(0, 3) = "SampleDate"
    FG1.TextMatrix(0, 4) = "Prod.Date"
    FG1.TextMatrix(0, 5) = "Reference"
    FG1.TextMatrix(0, 6) = "Remarks"
    
End Function
Function EnterFreshRecord1()
    i = i + 1
    If i >= 18 Then
        FG1.Rows = FG1.Rows + 1
    End If
        FG1.TextMatrix(i, 0) = ">>"
        FG1.TextMatrix(i, 1) = (i)
        FG1.TextMatrix(i, 2) = rstValue.Fields("Item") & ""
        FG1.TextMatrix(i, 3) = Format(rstValue.Fields("SDate"), "dd-mmm-yyyy") & ""
        FG1.TextMatrix(i, 4) = rstValue.Fields("PDate") & ""
        FG1.TextMatrix(i, 5) = rstValue.Fields("Reference") & ""
        FG1.TextMatrix(i, 6) = rstValue.Fields("Remarks") & ""
        
    
    Exit Function
End Function
Private Sub fillformcontrols()
    txtTNo.Text = ""
    txtTNo.Text = rsttrans.Fields("TransactionNo") & ""
   
End Sub
Function EnterFreshRecord()
    On Error GoTo ErrorHandler
       i = i + 1
    If i >= 18 Then
        FG1.Rows = FG1.Rows + 1
    End If
    FG1.TextMatrix(i, 0) = ">>"
    FG1.TextMatrix(i, 1) = (i)
    FG1.TextMatrix(i, 2) = Trim(cboItem.Text)
    FG1.TextMatrix(i, 3) = Trim(txtSDate)
    FG1.TextMatrix(i, 4) = Trim(txtPDate)
    FG1.TextMatrix(i, 5) = Trim(txtRef)
    FG1.TextMatrix(i, 6) = Trim(txtRemarks)
    
    Rearrange here is used to get the total amount and total qty immediately
  
    sql = "insert into RawMaterial values(" & txtTNo & ",#" & Format(Date, "dd-mmm-yyyy") & "#," & FG1.TextMatrix(i, 1) & ",'" & FG1.TextMatrix(i, 2) & "',#" & FG1.TextMatrix(i, 3) & "#,'" & FG1.TextMatrix(i, 4) & "','" & FG1.TextMatrix(i, 5) & "','" & FG1.TextMatrix(i, 6) & "')"
    con.Execute sql
    If Err.Number = -2147217900 Then
        'MsgBox "removeitem"
        FG1.Rows = FG1.Rows + 1
        FG1.RemoveItem (i)
        i = i - 1
            
        Rearrange
    End If
    
    ClearFormControl
    Rearrange
    cboItem.SetFocus
    Exit Function
ErrorHandler:
    If Err.Number = -2147217900 Then
        Resume Next
    End If
   If Err.Number = -2147467259 Then    'duplicate values (primary key violation)
       MsgBox "SerialNo Already Exits!" & vbCrLf & "Enter a Unique SerialNo"
       FG1.Rows = FG1.Rows + 1
       FG1.RemoveItem (i)
       i = i - 1
'
       Rearrange
       cboItem.SetFocus
       Exit Function
   End If
    MsgBox Err.Number & vbCrLf & Err.Description
End Function
Function RequiredLabel()

    MDIMain.lblF2.Visible = True
    MDIMain.lblF2.Caption = "F2 - Add"
    MDIMain.lblF3.Visible = True
    MDIMain.lblF3.Caption = "F3 - Edit"
    MDIMain.lblF4.Visible = True
    MDIMain.lblF4.Caption = "F4 - Remove"
    MDIMain.lblF5.Visible = True
    MDIMain.lblF5.Caption = "F5 - Save"
    MDIMain.lblF6.Visible = True
    MDIMain.lblF6.Caption = "F6 - Print"
  
    MDIMain.lblf9.Visible = True
    MDIMain.lblf9.Caption = "F9 - Exit"
End Function
Function ClearFormControl()
    cboItem.Text = ""
    txtPDate.Text = ""
    txtRef.Text = ""
    txtRemarks.Text = ""
    
End Function
Function Rearrange()
       k = 1
    While k < FG1.Rows
        If FG1.TextMatrix(k, 2) <> "" Then
            FG1.TextMatrix(k, 1) = k
            If k > 7 Then
                FG1.TopRow = k - 7
            Else
                FG1.TopRow = 1
            End If
         End If
        k = k + 1
    Wend
   
End Function
Function TransactionNumber()
    Dim rstdno As New ADODB.Recordset
    sql = "select max(TransactionNo) from RawMaterial"
    rstdno.Open sql, con
    If rstdno(0) <> "" Then
        tno = rstdno(0) + 1
    Else
        tno = 1
    End If
    txtTNo.Text = tno
    'sql = "insert into DNCustomer (DNoteNo) values(" & dnno & ")"
    'dbclr.Execute sql
    rstdno.Close
End Function
Function SaveTransaction()
    On Error GoTo ErrorHandler
    Dim s As Integer
       
   
    For s = 1 To i
        Sno = FG1.TextMatrix(s, 1)
        Item = FG1.TextMatrix(s, 2)
        sdate = FG1.TextMatrix(s, 3)
        pdate = FG1.TextMatrix(s, 4)
        ref = FG1.TextMatrix(s, 5)
        remarks = FG1.TextMatrix(s, 6)
        
        sql = "insert into RawMaterial values(" & txtTNo & ",#" & Format(Date, "dd-mmm-yyyy") & "#," & Sno & ",'" & Item & "',#" & sdate & "#,'" & pdate & "','" & ref & "','" & remarks & "')"
        
        'MsgBox sql
    con.Execute sql
    Next
    Exit Function
ErrorHandler:
    If Err.Number = -2147217900 Then
        Resume Next
    End If
    MsgBox Err.Number & vbCrLf & Err.Description
End Function
Function PrintTransaction()
    CR1.ReportFileName = App.Path & "\rptRaw.rpt"
    CR1.ReplaceSelectionFormula ("{RawMaterial.Transactionno}=" & txtTNo.Text & ";")
    CR1.FetchSelectionFormula
    CR1.RetrieveDataFiles
    CR1.WindowState = crptMaximized
    'CR1.ParameterFields(0) = "lblword;" & lblWords.Caption & ";true"
    'CR1.ParameterFields(1) = "InvAddress;" & repCustAdd & ";true"
    CR1.Action = 7
End Function

Private Sub cmdAdd_Click()
    Dim rstmax As New ADODB.Recordset
        rstmax.Open "select max(TransactionNo) from RawMaterial", con, 3
    If rstmax(0) <> "" Then
        txtTNo.Text = rstmax.Fields(0) + 1
    Else
        txtTNo.Text = 1
    End If
    rstmax.Close
    cboItem.SetFocus
End Sub

Private Sub cmdFirst_Click()
    FG1.Clear
    DefaultFlexGrid
    i = 0
    rsttrans.MoveFirst
    fillformcontrols
    cboItem.SetFocus
End Sub

Private Sub cmdLast_Click()
   FG1.Clear
    DefaultFlexGrid
    i = 0
    
    rsttrans.MoveLast
    fillformcontrols
    cboItem.SetFocus
End Sub

Private Sub cmdNext_Click()
    FG1.Clear
    DefaultFlexGrid
    i = 0
    rsttrans.MoveNext
    If rsttrans.EOF = True Then
        rsttrans.MoveLast
    End If
   fillformcontrols
   cboItem.SetFocus
End Sub

Private Sub cmdPrevious_Click()
   FG1.Clear
    DefaultFlexGrid
    i = 0
    rsttrans.MovePrevious
    If rsttrans.BOF = True Then
        rsttrans.MoveFirst
    End If
    fillformcontrols
    cboItem.SetFocus
End Sub

Private Sub Form_Activate()
    On Error GoTo ErrorHandler
    DisableLabel
    RequiredLabel
    i = 0
    FG1.Rows = 19
    FG1.Clear
    DefaultFlexGrid
    txtSDate = Format(Date, "dd-mmm-yyyy")
    DefaultFlexGrid
    TransactionNumber
    cboItem.SetFocus
    rstX.Open "select * from RawMaterial", con, 3
    rsttrans.Open "select distinct(TransactionNo) from RawMaterial order by TransactionNo", con, 3
     '---=-=====
    Dim rstCombo As New ADODB.Recordset
    Dim rawName
        
    rstCombo.Open "select RawItem from tblConfig where id=1", con, 3
    If rstCombo.RecordCount > 0 Then
        rawName = rstCombo.Fields("RawItem")
        
        rawName1 = Split(rawName, ",")
       
        
        If UBound(rawName1) > 0 Then
            cboItem.Clear
            For k = 0 To UBound(rawName1)
                cboItem.AddItem (rawName1(k))
            Next
        Else
            cboItem.Clear
            cboItem.AddItem rawName
        End If
        
        
        
    End If
    rstCombo.Close
    Exit Sub
ErrorHandler:
    If Err.Number = 3704 Or Err.Number = 3705 Then
        Resume Next
    End If
    MsgBox Err.Number & vbCrLf & Err.Description
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DisableLabel
    EnableLabel
End Sub

Private Sub smAdd_Click()
    cmdAdd_Click
End Sub

Private Sub smEdit_Click()
    frameRemove.Visible = False
    frameEdit.Visible = True
    txtEdit.Text = ""
    txtEdit.SetFocus
End Sub

Private Sub smExit_Click()
Unload Me
End Sub

Private Sub smPrint_Click()
PrintTransaction
End Sub

Private Sub smRemove_Click()
    frameEdit.Visible = False
    frameRemove.Visible = True
    txtRemove.Text = ""
    txtRemove.SetFocus
End Sub

Private Sub smSave_Click()
SaveTransaction
End Sub

Private Sub cboItem_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13
            txtSDate.SetFocus
            SendKeys "{end}"
    End Select
End Sub

Private Sub txtEdit_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Val(txtEdit) > 0 And Val(txtEdit) <= i Then
            frameEdit.Visible = False
            cboItem.Text = FG1.TextMatrix(Val(txtEdit), 2)
            txtSDate.Text = FG1.TextMatrix(Val(txtEdit), 3)
            txtPDate.Text = FG1.TextMatrix(Val(txtEdit), 4)
            txtRef.Text = FG1.TextMatrix(Val(txtEdit), 5)
            txtRemarks.Text = FG1.TextMatrix(Val(txtEdit), 6)
            cboItem.SetFocus
            SendKeys "{END}"
            FG1.RemoveItem (Val(txtEdit))
            
            'deleting the deleted item from database
            sql = "delete from RawMaterial where SNo=" & Trim(txtEdit.Text) & "and TransactionNo=" & Trim(txtTNo.Text)
            'MsgBox sql
            con.Execute sql
            Dim newsno
            iam updating here slno, since slno is changed upon removal of slno
            For k = (Val(txtEdit) + 1) To i
                sql1 = "select sno from RawMaterial where TransactionNo=" & txtTNo & "and sno =" & k
                rstX.Close
                rstX.Open sql1, con, 3
                newsno = rstX(0)
                newsno1 = newsno - 1
                
                sql2 = "update RawMaterial set SNo=" & newsno1 & " where sno=" & newsno & "and TransactionNo=" & txtTNo
                con.Execute sql2
                
            Next k
            
            i = i - 1
            Rearrange
           
        Else
            txtEdit.Text = ""
        End If
    ElseIf KeyAscii = 27 Then
        frameEdit.Visible = False
        txtEdit.Text = ""
        frmEntry.Refresh
        cboItem.SetFocus
    ElseIf KeyAscii > 46 And KeyAscii < 58 Then
        KeyAscii = KeyAscii
    ElseIf KeyAscii = 8 Then
        KeyAscii = 8
    Else
        KeyAscii = 0
    End If
    
End Sub

Private Sub txtPDate_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13
            txtRef.SetFocus
        Case 8
            If txtPDate.Text = "" Then
                txtSDate.SetFocus
            Else
                Exit Sub
            End If
    End Select
End Sub

Private Sub txtRef_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13
            txtRemarks.SetFocus
        Case 8
            If txtRef.Text = "" Then
                txtPDate.SetFocus
            Else
                Exit Sub
            End If
    End Select
End Sub

Private Sub txtRemarks_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13
            If Trim(cboItem.Text) = "" Then
                MsgBox "Enter Item Details"
                cboItem.SetFocus
                Exit Sub
            ElseIf Trim(txtSDate) = "" Then
                MsgBox "Enter Sample Date"
                txtSDate.SetFocus
            ElseIf Not IsDate(txtSDate.Text) Then
                MsgBox "Enter Valid SampleDate"
                txtSDate.SetFocus
                SendKeys "{end}"
                Exit Sub
            End If
            EnterFreshRecord
            SaveTransaction
            cboItem.SetFocus
        Case 8
            If txtRemarks.Text = "" Then txtRef.SetFocus
            
    End Select
End Sub

Private Sub txtRemove_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Val(txtRemove) > 0 And Val(txtRemove) <= i Then
            frameRemove.Visible = False
            cboItem.SetFocus
            FG1.RemoveItem (Val(txtRemove))
            'deleting the deleted item from database
            sql = "delete from RawMaterial where SNo=" & Trim(txtRemove.Text) & "and TransactionNo=" & Trim(txtTNo.Text)
            'MsgBox sql
            con.Execute sql
            Dim newsno
            iam updating here slno, since slno is changed upon removal of slno
            For k = (Val(txtRemove) + 1) To i
                sql1 = "select sno from RawMaterial where TransactionNo=" & txtTNo & "and sno =" & k
                rstX.Close
                rstX.Open sql1, con, 3
                newsno = rstX(0)
                newsno1 = newsno - 1
                
                sql2 = "update RawMaterial set SNo=" & newsno1 & " where sno=" & newsno & "and transactionno=" & txtTNo
                con.Execute sql2
                
            Next k
            i = i - 1
            Rearrange
          
        Else
            txtRemove.Text = ""
        End If
    ElseIf KeyAscii = 27 Then
        frameRemove.Visible = False
        txtRemove.Text = ""
        frmEntry.Refresh
        cboItem.SetFocus
    ElseIf KeyAscii > 46 And KeyAscii < 58 Then
        KeyAscii = KeyAscii
    ElseIf KeyAscii = 8 Then
        KeyAscii = 8
    Else
        KeyAscii = 0
    End If

End Sub

Private Sub txtSDate_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13
            txtPDate.SetFocus
        Case 8
            If txtSDate.Text = "" Then
                cboItem.SetFocus
            Else
                Exit Sub
            End If
    End Select
End Sub

Private Sub txtTNo_Change()
    On Error GoTo ErrorHandler
    
    FG1.Clear
    i = 0
    DefaultFlexGrid
    If txtTNo.Text <> "" Then
        sql = "select * from RawMaterial where TransactionNo = " & txtTNo.Text
        rstValue.Open sql, con, 3
        If rstValue.RecordCount > 0 Then
            rstValue.MoveFirst
            While Not rstValue.EOF
                EnterFreshRecord1
                rstValue.MoveNext
            Wend
            
        End If
        rstValue.Close
    End If
    Exit Sub
ErrorHandler:
    If Err.Number = 3704 Then
        Resume Next
    End If
    MsgBox Err.Description
End Sub