Anyone, please help me to make a program that has something to do with POS in Visual Basic ... Please! Thank you . You can email it at email removed

Edited 5 Years Ago by WaltP: n/a

This is simple sales... now show us that you are willing to participate in development of your homework so we can help you further

For codedown you need only a Form and CommandButton (named Command button 1)

Private Sub Command1_Click()
Dim qty As Double
Dim partno As String
Dim price As Double

partno = InputBox("Which partno do you want to sale", "Sales", 0)
qty = InputBox("Please Enter quantity for partno " & partno, "Sales", 0)
price = InputBox("Please Enter Sales price for " & qty & " pcs of " & partno, "SAles", 0)

MsgBox "You bill is " & Chr(13) & partno & " " & qty & " x  " & price & Chr(13) & _
"                    " & Round(qty * price), vbOKOnly, "Sales"

End Sub

Sending u a POS form code,u better understand and make it according to ur requirement

Option Explicit
Dim gSlno, gItemCode, gItemname, gQty, gRate, gTotal, Inti
Dim Indx
Private Sub cmbItmcode_Change()
MsfBill.Text = cmbItmcode.Text
End Sub

Private Sub cmbItmcode_KeyPress(KeyAscii As Integer)
On Error GoTo Err_Handler
If KeyAscii = 13 Then
   cmbItmcode.Visible = False
   MsfBill.TextMatrix(Indx, 1) = cmbItmcode.Text
   If Rs.State = 1 Then Rs.Close
   Rs.Open "select itmname,Rate from itemmaster where itmcode='" & cmbItmcode.Text & "'"
      If Not Rs.EOF Then
         MsfBill.TextMatrix(Indx, 2) = Rs!Itmname & ""
         MsfBill.TextMatrix(Indx, 3) = Rs!Rate & ""
         MsfBill.Col = 4
         ArrangeTextbox txtEnter
      Else
         MsgBox "Invalid Item code Please Check it ", vbCritical
         MsfBill.Col = 1
         ArrangeTextbox cmbItmcode
      End If
End If
Exit Sub
Err_Handler:
If Err.Number > 0 Then
  MsgBox Err.Description, vbCritical
End If
End Sub

Private Sub Form_Activate()
On Error GoTo Err_Handler
MsfBill.SetFocus
MsfBill.Row = 1
MsfBill.Col = 1
ArrangeTextbox cmbItmcode
Indx = 1
MsfBill.TextMatrix(Indx, 0) = Indx
txtInvoiceNo.Text = GetNewNo("select max(invoiceNo)+1 from sales")
Exit Sub
Err_Handler:
If Err.Number > 0 Then
  MsgBox Err.Description, vbCritical
End If
End Sub

Private Sub Form_Load()
MsfRefresh
FillCombo cmbItmcode, "select itmcode from ItemMaster"
End Sub
Private Sub MsfRefresh()
With MsfBill
      .Clear
      .Cols = 5
      .Rows = 2
      .FormatString = "^SL No | Item Code | Item Name | Rate  | Qty  | Total "
       gSlno = 0
       gItemCode = 1
       gItemname = 2
       gQty = 3
       gRate = 4
       gTotal = 5
       .Row = 0
       For Inti = 0 To .Cols - 1
          .Col = Inti
          .CellFontBold = True
       Next
       .ColWidth(gSlno) = 10 * 100
       .ColWidth(gItemCode) = 26 * 100
       .ColWidth(gItemname) = 26 * 100
       .ColWidth(gRate) = 15 * 100
       .ColWidth(gQty) = 15 * 100
       .ColWidth(gTotal) = 15 * 100
       .RowHeight(0) = 350
       .RowHeightMin = 350
End With
End Sub

Private Sub ArrangeTextbox(ctrl As Control)
  ctrl.Left = MsfBill.Left + MsfBill.CellLeft
  ctrl.Top = MsfBill.Top + MsfBill.CellTop
  ctrl.Text = MsfBill.Text
  ctrl.Width = MsfBill.ColWidth(MsfBill.Col) - 10
  If TypeOf ctrl Is TextBox Then
  ctrl.Height = MsfBill.RowHeight(MsfBill.Row) - 10
  End If
  ctrl.Visible = True
  ctrl.Text = ""
  ctrl.SetFocus
  ctrl.SelStart = 0
  ctrl.SelLength = Len(ctrl.Text)
End Sub

Private Sub ImgCancel_Click()
Me.Hide
frmMaster.Show
End Sub

Private Sub ImgNew_Click()
Clear frmsalesbill
txtInvoiceNo.Text = GetNewNo("select max(invoiceNo)+1 from sales")
MsfRefresh
MsfBill.SetFocus
MsfBill.Row = 1
MsfBill.Col = 1
ArrangeTextbox cmbItmcode
Indx = 1
MsfBill.TextMatrix(Indx, 0) = Indx
End Sub

Private Sub ImgSave_Click()
On Error GoTo Err_Handler
Dim I
Dim TrxType
TrxType = "S"
If MsgBox("Do you want to Save Bill", vbQuestion + vbYesNo + vbDefaultButton1, "Save Items") = vbYes Then
    For I = 1 To MsfBill.Row
     If Len(Trim(MsfBill.TextMatrix(I, 1))) = 0 Then
           MsgBox "Item Code. is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 1
           Exit Sub
        End If
        If Len(Trim(MsfBill.TextMatrix(I, 4))) = 0 Then
           MsgBox "Qty. is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 41
           Exit Sub
        End If
        If Len(Trim(MsfBill.TextMatrix(I, 3))) = 0 Then
           MsgBox "Rate is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 3
           Exit Sub
        End If
        If Val(MsfBill.TextMatrix(I, 3)) = 0 Then
           MsgBox "Cheque Amount is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 3
           Exit Sub
        End If
    Next
    For I = 1 To MsfBill.Row
        Update1 "Stock", MsfBill.TextMatrix(I, 1), MsfBill.TextMatrix(I, 4) * -1, TrxType, MsfBill.TextMatrix(I, 3)
        Update1 "Sales", txtInvoiceNo.Text, Format(Date, "dd-mmm-yyyy"), MsfBill.TextMatrix(I, 1), MsfBill.TextMatrix(I, 4), TrxType, MsfBill.TextMatrix(I, 5), txtTotal
    Next
    MsgBox "New Bill  details sucessfully Updated", vbInformation
    txtInvoiceNo.Text = GetNewNo("select max(invoiceNo)+1from sales")
    ImgNew_Click
End If
Exit Sub
Err_Handler:
If Err.Number > 0 Then
  MsgBox Err.Description, vbCritical
End If
End Sub

Private Sub MsfBill_Click()
  If MsfBill.Col = 1 Then
     MsfBill.Col = 1
     ArrangeTextbox cmbItmcode
  ElseIf MsfBill.Col = 2 Then
     MsfBill.Col = 2
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 3 Then
     MsfBill.Col = 3
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 4 Then
     MsfBill.Col = 4
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 5 Then
     MsfBill.Col = 5
     ArrangeTextbox txtEnter
  End If
End Sub

Private Sub Timer1_Timer()
LblDateTime.Caption = Time & " " & Format(Date, "DDDD")
End Sub

Private Sub txtEnter_Change()
MsfBill.Text = txtEnter.Text
End Sub

Private Sub txtEnter_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  If MsfBill.Col = 1 Then
     MsfBill.Col = 2
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 2 Then
     MsfBill.Col = 3
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 3 Then
     MsfBill.Col = 4
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 4 Then
      MsfBill.TextMatrix(Indx, 5) = Val(MsfBill.TextMatrix(Indx, 3)) * Val(MsfBill.TextMatrix(Indx, 4))
      FlexgridTotal
      If MsgBox("Do you want to add Additional Items", vbQuestion + vbYesNo + vbDefaultButton1, "Additional Items") = vbYes Then
           MsfBill.Rows = MsfBill.Rows + 1
           Indx = Indx + 1
           MsfBill.Col = 1
           MsfBill.Row = Indx
           MsfBill.TextMatrix(Indx, 0) = Indx
           txtEnter.Visible = False
           ArrangeTextbox cmbItmcode
      Else
          ImgSave_Click
  End If
End If
End If
End Sub
Private Sub FlexgridTotal()
Dim sTot
If Indx = 1 Then
sTot = Val(MsfBill.TextMatrix(Indx, 5))
End If
sTot = Val(txtTotal) + Val(MsfBill.TextMatrix(Indx, 5))
txtTotal.Text = sTot
End Sub
Private Function CalculateTotAmount()
 Dim ToTamt
        ToTamt = 0
         For Inti = 1 To MsfBill.Rows - 1
            ToTamt = ToTamt + Val(MsfBill.TextMatrix(Inti, 3))
        Next
        CalculateTotAmount = Val(ToTamt)
End Function

.

@Monarchmk u r right, i think we should leave him ...

Not only that, but giving free code away is frowned upon. If they can't post their code, how can they understand your code?

This article has been dead for over six months. Start a new discussion instead.