⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmchallan.frm

📁 This a complete inventory management system that performs the functions of Purchases, Sales and paym
💻 FRM
📖 第 1 页 / 共 2 页
字号:
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "&Delete"
            Key             =   "Delete"
            Object.ToolTipText     =   "Delete"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "&Close"
            Key             =   "Exit"
            Object.ToolTipText     =   "Exit"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Caption         =   "&Print"
            Key             =   "Print"
            Object.ToolTipText     =   "Print"
            ImageIndex      =   6
         EndProperty
         BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Style           =   3
         EndProperty
      EndProperty
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "SUB TOTAL "
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   195
      Index           =   14
      Left            =   6360
      TabIndex        =   23
      Top             =   5085
      Width           =   1110
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "VAT/CST % "
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   195
      Index           =   1
      Left            =   6240
      TabIndex        =   22
      Top             =   5400
      Width           =   1185
   End
   Begin VB.Label Label1 
      Caption         =   "CARTAGE"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   195
      Index           =   2
      Left            =   6360
      TabIndex        =   21
      Top             =   5760
      Width           =   975
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Grand Total "
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   195
      Index           =   4
      Left            =   6240
      TabIndex        =   20
      Top             =   6120
      Width           =   1200
   End
End
Attribute VB_Name = "frmChallan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Cmd_AddRow_Click()
If Not Trim(txtPartyId) = "" Then
    If CheckGrid = True Then
       With VSF
            If VSF.Editable = flexEDNone Or VSF.Editable = flexEDKbd Then
                VSF.Editable = flexEDKbdMouse
            End If
            .Rows = VSF.Rows + 1
            .ColComboList(1) = "..."
            .Select .BottomRow, 0
        End With
    End If
Else
    MsgBox "You have not selected any Party", vbCritical
    txtParty.SetFocus
    Exit Sub
End If
End Sub

Private Sub Cmd_DelRow_Click()
If VSF.Rows > 1 Then
If MsgBox("Are you sure you want to delete the current row ?", vbQuestion + vbYesNo) = vbYes Then
   VSF.RemoveItem (VSF.Row)
End If
End If
GetTotal (vRow)
End Sub

Private Sub cmdDispParty_Click()
    popBranch.Show vbModal
    gId = popBranch.txtBranchId
    txtPartyId = Trim(gId)
    txtParty = BRID2BRName(Trim(gId))
    'MsgBox gId
    Unload popBranch
End Sub

Private Sub Form_Load()
dtIn_Date.Value = Now
End Sub

Private Sub Tlb_Kit_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
    Case 1
        Call fn_new
    Case 3
        Call fn_Save
    Case 5
        Call fn_Edit
    Case 7
        Call fn_Delete
    Case 9
        Unload Me
    Case 11
        'Call fn_Print
End Select
End Sub

Private Sub txtDiscount_Change()
    calcVal
End Sub

Private Sub txtPacking_Change()
    calcVal
End Sub

Private Sub txtVat_Change()
    calcVal
End Sub

Private Sub VSF_AfterEdit(ByVal Row As Long, ByVal Col As Long)
Select Case Col
    Case 0
                    
    Case 1
    
    Case 2
    
    Case 3
    
    Case 4
        Dim gStock
       ' gStock = fn_CheckStock(VSF.TextMatrix(Row, 0), txtChallanDate, Val(VSF.TextMatrix(Row, 3)))
        If gMod = 0 Then
            Call GetTotal(Row)
        Else
            gStock = gStock + gChallanQty
            If gStock < Val(VSF.TextMatrix(Row, 3)) Then
                MsgBox "Product Qty cannot be greater than qty in stock on that particular date!", vbCritical, "iManager"
                MsgBox "Current Stock is " & gStock, vbCritical, "iManager"
                VSF.TextMatrix(Row, 3) = Val(gStock)
            End If
            Call GetTotal(Row)
        End If
        
    Case 5
        VSF.TextMatrix(Row, 4) = Trim(Replace(FormatNumber(Val(VSF.TextMatrix(Row, 4)), 2), ",", ""))
        Call GetTotal(Row)
    Case 6
    
End Select
End Sub

Private Sub VSF_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
Select Case Col
    Case 0
        VSF.ColComboList(0) = "..."
    Case 1
        Cancel = True
    Case 2
        If Trim(VSF.TextMatrix(VSF.Row, 0)) = "" Then Cancel = True
        
    Case 3
        If Trim(VSF.TextMatrix(VSF.Row, 0)) = "" Then Cancel = True
         
    Case 4
        If Trim(VSF.TextMatrix(VSF.Row, 0)) = "" Then Cancel = True
    Case 5
       If Trim(VSF.TextMatrix(VSF.Row, 0)) = "" Then Cancel = True
    Case 6
        Cancel = False
End Select
End Sub

Private Sub VSF_CellButtonClick(ByVal Row As Long, ByVal Col As Long)
Select Case Col
    Case 0
        Dim gPID
        Dim gValidate
        gValidate = ""
        popBook.Show vbModal
        gPID = Trim(popBook.txtBookID)
        Unload popBook
        If Trim(gPID) = "" Then
            For i = 0 To VSF.Cols - 1
                VSF.TextMatrix(VSF.Row, i) = ""
            Next
        Exit Sub
        End If
        'For i = 1 To VSF.Rows - 1
            'If Trim(VSF.TextMatrix(i, 0)) = gPID Then
                'MsgBox "Product already entered", vbCritical
                'Exit Sub
            'End If
       ' Next
      
        If Not Trim(gPID) = "" Then
            VSF.TextMatrix(Row, 0) = gPID
        End If
        If Not Trim(VSF.TextMatrix(Row, 0)) = "" Then
            VSF.TextMatrix(Row, 1) = PID2PName(Trim(VSF.TextMatrix(Row, 0)))
            VSF.TextMatrix(Row, 3) = ""
            VSF.TextMatrix(Row, 4) = Trim(Replace(FormatNumber(SuggestedRP(Trim(VSF.TextMatrix(Row, 0))), 2), ",", ""))
            VSF.TextMatrix(Row, 5) = ""
        Else
            For i = 1 To VSF.Cols - 1
                VSF.TextMatrix(Row, i) = ""
            Next
        End If
    Case 1
    
    Case 2
    
    Case 3
    
    Case 4
    
    Case 5
    
End Select
End Sub
Private Function CheckGrid() As Boolean
If VSF.Rows > 1 Then
    For i = 1 To VSF.Rows - 1
        If VSF.TextMatrix(i, 0) = "" Then
            MsgBox "INCOMPLETE ROW - No Product is selected", vbCritical
            CheckGrid = False
            VSF.Select i, 0
            Exit Function
        End If
        If Not Val(VSF.TextMatrix(i, 4)) > 0 Then
            MsgBox "INCOMPLETE ROW - Quantity should be greater then zero", vbCritical
            CheckGrid = False
            VSF.Select i, 3
            Exit Function
        End If
        If Not Val(VSF.TextMatrix(i, 5)) > 0 Then
            MsgBox "INCOMPLETE ROW - Rate should be greater then zero", vbCritical
            CheckGrid = False
            VSF.Select i, 4
            Exit Function
        End If
    Next
End If
CheckGrid = True
End Function
Private Function SuggestedRP(vPID As Variant) As Variant
Dim rst As Recordset
Set rst = New Recordset
rst.Open "select * from aBookMaster where b_Id='" & vPID & "'", CNimanager
    If Not rst.EOF Or Not rst.BOF Then
        SuggestedRP = rst("b_SellingPrice")
    Else
        SuggestedRP = "0"
    End If
End Function
Private Function fn_Save()
    Dim lValidate As Integer
    lVaidate = Fn_CheckBlankGridCell
    If lVaidate = 0 Then
     Call prcSave
    End If
End Function
Private Sub prcSave()
Dim msql
Dim rsCheck As New ADODB.Recordset
Dim lSQL As String
 Dim ProductId, ProductName, prod_size, Qty, Rate, Amount
   
  
  
   If chkBlank(txtParty, "Party Name") = True Then
        cmdDispParty.SetFocus
        Exit Sub
   End If
   
    
    If VSF.Rows = 1 Then
        MsgBox "No Product Selected....", vbInformation
        Exit Sub
    End If
    
    For i = 1 To VSF.Rows - 1
        gQty = Val(VSF.TextMatrix(i, 4))
        If gQty <= 0 Then
            MsgBox "Qty should be greater than 0", vbCritical, "iManager"
            Exit Sub
        End If
    Next
   
   rsCheck.Open "Select * from challan where challan_no='" & txtInvno & "'", CNimanager
   
   If Not rsCheck.EOF Then
        MsgBox "Invoice Number Already Exist..", vbInformation
        txtInvno.SetFocus
        Exit Sub
   End If
   rsCheck.Close
   
    For i = 1 To VSF.Rows - 1
        ProductId = VSF.TextMatrix(i, 0)
        ProductName = VSF.TextMatrix(i, 1)
        prod_size = VSF.TextMatrix(i, 3)
        Qty = Val(VSF.TextMatrix(i, 4))
        Rate = Val(VSF.TextMatrix(i, 5))
        Amount = Val(VSF.TextMatrix(i, 6))
    
        msql = "Insert into challan(inv_no,inv_date,challan_no,ord_no,desp_mode,party_id,party_name,sno,prod_id,prod_name,prod_size,qty,um,rate,amount,sub_total,vat,packing,discount,grand_tot) values"
        msql = msql & "('" & txtInvno & "','" & dtIn_Date.Value & "','" & txtOrdNo & " ','" & txtChallanNo & "','" & txtDispatchMode & " ','" & txtPartyId & "','" & txtParty & "'," & i & ",'" & ProductId & "','" & ProductName & "','" & prod_size & "'," & Qty & ",'" & PID2Unit(ProductId) & "'," & Rate & "," & Amount & "," & txtsubTotal & ", " & txtVat & "," & txtPacking & "," & txtDiscount & "," & txtGrandTotal & ")"
        'MsgBox msql
        CNimanager.Execute (msql)
       ' msql = "insert into stock(product_id,size_set,product_name,party_id,party_name,bill_no,in_date,avlb_qty,qty_in,qty_out,rest_qty) values('" & ProductId & "','" & Trim(prod_size) & "','" & ProductName & "','" & txtPartyId & "','" & txtParty & "','SALE','" & dtIn_Date.Value & "'," & GetAvlbQty(ProductId, prod_size) & ",0," & Qty & "," & GetAvlbQty(ProductId, prod_size) - Qty & ")"
        'CNimanager.Execute (msql)
    Next
    
    MsgBox "Challan Created............", vbInformation
    
    fn_new
End Sub

Private Function GetAvlbQty(ProductId, prod_size)
Dim msql As String
Dim rsCheckStock As New ADODB.Recordset

msql = "Select sum(qty_in)-sum(qty_out) as avlbQty from stock where product_id='" & ProductId & "' and in_date<=#" & dtIn_Date.Value & "# and size_set='" & Trim(prod_size) & "'"
'MsgBox msql
rsCheckStock.Open msql, CNimanager
If Not rsCheckStock.EOF Then
     If IsNull(rsCheckStock("avlbQty")) Then
        GetAvlbQty = 0
    Else
        GetAvlbQty = rsCheckStock("avlbQty")
    End If
    
Else
    GetAvlbQty = 0
End If
rsCheckStock.Close
Set rsCheckStock = Nothing
End Function
Private Function fn_new()
    Unload Me
    Load Me
End Function
Private Function GetTotal(vRow)
Dim gTotal
gTotal = 0
VSF.TextMatrix(vRow, 6) = Trim(Replace(FormatNumber(Val(VSF.TextMatrix(vRow, 5)) * Val(VSF.TextMatrix(vRow, 4)), 2), ",", ""))
For i = 1 To VSF.Rows - 1
    gTotal = gTotal + Val(VSF.TextMatrix(i, 6))
Next
txtsubTotal = Trim(Replace(FormatNumber(Val(gTotal), 2), ",", ""))
txtGrandTotal = Trim(Replace(FormatNumber(Val(gTotal), 2), ",", ""))
End Function

Private Function calcVal()
On Error Resume Next
    txtGrandTotal = CDbl(txtsubTotal) + CDbl((CDbl(txtsubTotal) * CDbl(txtVat) / 100)) + CDbl(txtPacking) - CDbl(txtDiscount)

End Function

Private Sub fn_Edit()
    popInvoice.Show vbModal
    txtInvno = popInvoice.txtBookID
    Unload popInvoice
End Sub

Private Sub fn_Delete()
Dim msql As String
Dim ans
msql = "Delete from challan where inv_no='" & txtInvno & "'"
ans = MsgBox("Are you Sure...", vbYesNoCancel)

If ans = vbYes Then
    CNimanager.Execute (msql)
    MsgBox "Record Deleted Successfully..", vbInformation
    Unload Me
    Load Me
End If

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -