a little help with this code-VBForums
Results 1 to 8 of 8

Thread: a little help with this code

  1. #1

    Thread Starter
    New Member
    Join Date
    Dec 2017
    Posts
    2

    a little help with this code

    when i try to return the product its doing nothing ...

    item return
    and
    item qty


    Code:
    Public Sub SelectAll(Editctr As Control)
    With Editctr
    .SelStart = 0
    .SelLength = Len(Editctr.Text)
    .SetFocus
    End With
    End Sub
    
    Private Sub Command1_Click()
    picsasia.Visible = False
    txtbarkodi.SetFocus
    End Sub
    
    Private Sub Command2_Click()
    On Error Resume Next
    If txtzbritja2.Text = "" Then
    MsgBox "الرجاء إدخال كمية الخصم", vbInformation, "Smart CASH 2.0"
    Else
    lbltotal.Caption = Format(CCur(lbltotal.Caption) - CCur(lbltotal / 100 * txtzbritja2), "###,###,###0.00")
    piczbritja2.Visible = False
    txtbarkodi.SetFocus
    End If
    End Sub
    
    Private Sub Command3_Click()
    'Zbritja
    '***********************************************************
    On Error Resume Next
    If txtzbritja.Text = "" Then
    MsgBox "الرجاء إدخال كمية الخصم", vbInformation, "Smart CASH 2.0"
    Else
    lvshitja.ListItems(lvshitja.SelectedItem.Index).SubItems(2) = Format(CCur(lvshitja.SelectedItem.SubItems(2)) - CCur(lvshitja.SelectedItem.SubItems(2) / 100 * txtzbritja), "###,###,###0.00")
    txtshuma = Format(CCur(lvshitja.SelectedItem.SubItems(4)), "###,###,###0.00")
    lvshitja.ListItems(lvshitja.SelectedItem.Index).SubItems(4) = Format(CCur(lvshitja.SelectedItem.SubItems(2)) * CCur(lvshitja.SelectedItem.SubItems(3)), "###,###,###0.00")
    txtshuma2 = Format(CCur(txtshuma) - CCur(lvshitja.SelectedItem.SubItems(4)), "###,###,###0.00")
    lbltotal.Caption = Format(CCur(lbltotal.Caption) - CCur(txtshuma2), "###,###,###0.00")
    txtzbritja.Text = ""
    piczbritja.Visible = False
    End If
    End Sub
    
    Private Sub Form_Load()
    On Error Resume Next
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.CommPort = 1                ' Change CommPort to Appropriate Number
    MSComm1.PortOpen = True
    LCD_Command (LCD_CLR)
    frmShitja.MSComm1.Output = txbuff
    LCD_Command (LCD_CLR)
    frmShitja.MSComm1.Output = txbuff
    LCD_Command (NEXT_LINE)
    frmShitja.MSComm1.Output = txbuff
    txbuff = "> B I G    S T A R <"
    MSComm1.Output = txbuff
    '------------------------
    Call ListView_FullRowSelect(lvshitja)
    lbldata.Caption = Format(Now, "dd/mm/yyyy")
    Dim Arq1 As String
    Dim Arq2 As String
    Dim Arq3 As String
    Arq1 = ReadINI(App.Path & "\Konfigurimi.ini", "Arka", "Arka")
    Arq2 = ReadINI(App.Path & "\Konfigurimi.ini", "Kompania", "Kompania")
    Arq3 = ReadINI(App.Path & "\Paragoni.ini", "Numri", "Numri")
    lblarka.Caption = Arq1
    lblfirma.Caption = Arq2
    lblnumri.Caption = Arq3
    End Sub
    
    Private Sub Image2_Click()
    frmAbout.Show 1
    End Sub
    
    Private Sub lvshitja_GotFocus()
    txtbarkodi.Text = ""
    End Sub
    
    Private Sub lvshitja_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyDelete
    If lvshitja.ListItems.Count = 0 Then
    Exit Sub
    Else
    minusamount = lvshitja.ListItems(lvshitja.SelectedItem.Index).SubItems(4)
    lbltotal.Caption = Format(CCur(lbltotal.Caption) - minusamount, "###,###,##0.00")
    lvshitja.ListItems.Remove (lvshitja.SelectedItem.Index)
    txtbarkodi.Enabled = True
    txtbarkodi.SetFocus
    lvshitja.Enabled = True
    End If
    'Zbritja========================================
    Case vbKeySubtract
    piczbritja.Visible = True
    txtzbritja.SetFocus
    If lvshitja.ListItems.Count = 0 Then
    Exit Sub
    Else
    lblartikulli.Caption = lvshitja.SelectedItem.SubItems(1)
    lblqmimi.Caption = lvshitja.SelectedItem.SubItems(2)
    End If
    End Select
    End Sub
    
    Private Sub mnuanulo_Click()
    If lvshitja.ListItems.Count = 0 Then
    MsgBox "لا توجد أي عناصر في قائمة المبيعات.", vbOKOnly + vbInformation
    Else
    If MsgBox("هل أنت متأكد أنك تريد إلغاء العملية الحالية؟", vbYesNo + vbQuestion) = vbYes Then
    lvshitja.ListItems.Clear
    txtbarkodi.Enabled = True
    txtbarkodi.SetFocus
    inttotal = 0
    lbltotal.Caption = "0.00"
    txtshuma = "0.00"
    txtshuma2 = "0.00"
    Else
    Cancel = 1
    End If
    End If
    On Error Resume Next
    LCD_Command (LCD_CLR)
    frmShitja.MSComm1.Output = txbuff
    LCD_Command (LCD_CLR)
    frmShitja.MSComm1.Output = txbuff
    LCD_Command (NEXT_LINE)
    frmShitja.MSComm1.Output = txbuff
    txbuff = "> B I G    S T A R <"
    frmShitja.MSComm1.Output = txbuff
    End Sub
    
    Private Sub mnucash_Click()
    frmPagesa.txttotal.Text = lbltotal.Caption
    frmPagesa.Show 1
    End Sub
    
    Private Sub mnudalja_Click()
    'I use this for customer display*************
    On Error Resume Next
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.CommPort = 1
    MSComm1.PortOpen = True
    LCD_Command (LCD_CLR)
    frmShitja.MSComm1.Output = txbuff
    LCD_Command (LCD_CLR)
    frmShitja.MSComm1.Output = txbuff
    LCD_Command (NEXT_LINE)
    frmShitja.MSComm1.Output = txbuff
    txbuff = "> Apple Syria <"
    MSComm1.Output = txbuff
    '------------------------
    End
    End Sub
    
    Private Sub mnufshij_Click()
    If lvshitja.ListItems.Count = 0 Then
    MsgBox "لا توجد أي عناصر في قائمة المبيعات", vbInformation
    Else
    lvshitja.SetFocus
    End If
    End Sub
    
    Private Sub mnuKerko_Click()
    frmKerko.Show 1
    End Sub
    
    Private Sub mnukonfig_Click()
    frmKonfigurimi.Show 1
    End Sub
    
    Private Sub mnuqkyqja_Click()
    frmxLogIn.Show 1
    End Sub
    
    Private Sub mnusasia_Click()
    picsasia.Visible = True
    txtsasia.SetFocus
    End Sub
    
    Private Sub mnush_Click()
    Shell App.Path & "\st_update.exe", vbHide
    Shell App.Path & "\st_plus.exe", vbHide
    End Sub
    
    Private Sub mnuZbritja_Click()
    lvshitja.SetFocus
    End Sub
    
    Private Sub mnuZbritjatotale_Click()
    piczbritja2.Visible = True
    txtzbritja2.SetFocus
    End Sub
    
    Private Sub txtbarkodi_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeySubtract
    For ilst = 1 To frmShitja.lvshitja.ListItems.Count
    lstid = frmShitja.lvshitja.ListItems(ilst).Text
    lstpershkrimi = frmShitja.lvshitja.ListItems(ilst).SubItems(1)
    lstsasia = frmShitja.lvshitja.ListItems(ilst).SubItems(3)
    'Fshirja nga Shitja ***********************************************
    On Error Resume Next
    Set ac = New ADODB.Connection
    Set ar = New ADODB.Recordset
    Call dbconek
    ac.Open strConek
    With ar
    criteria = "Select *From tblShitja Where barkodi='" & lstid & "'"
    .Open criteria, strConek, adOpenStatic, adLockOptimistic
    .Delete
    .Close
    End With
    'Nderrimi i sasive
    '***********************************************************
    Set ac = New ADODB.Connection
    Set ar = New ADODB.Recordset
    Call dbconek
    ac.Open strConek
    With ar
    criteria = "Select *From tblArtikujt Where barkodi='" & lstid & "'"
    .Open criteria, strConek, adOpenStatic, adLockOptimistic
    !sasia = Val(!sasia) + Val(lstsasia)
    .Update
    .Close
    End With
    '=================================================================
    Next
    lvshitja.ListItems.Clear
    lbltotal.Caption = "0.00"
    inttotal = 0
    txtbarkodi.Text = ""
    txtbarkodi.SetFocus
    MsgBox "تم الانتهاء من العودة للعناصر بنجاح !", vbInformation
    txtbarkodi.Text = ""
    End Select
    End Sub
    
    Private Sub txtbarkodi_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
    Set ac = New ADODB.Connection
    Set ar = New ADODB.Recordset
    Call dbconek
    ac.Open strConek
    With ar
    criteria = "Select *From tblartikujt Where barkodi='" & txtbarkodi & "'"
    .Open criteria, strConek, adOpenStatic, adLockOptimistic
    If .RecordCount = 1 Then
    lvshitja.ListItems.Add , , txtbarkodi
    lvshitja.ListItems(lvshitja.ListItems.Count).SubItems(1) = !pershkrimi
    lvshitja.ListItems(lvshitja.ListItems.Count).SubItems(2) = Format(CCur(!qmimi_shitjes), "###,###,###0.00")
    lvshitja.ListItems(lvshitja.ListItems.Count).SubItems(3) = txtsasia.Text
    lvshitja.ListItems(lvshitja.ListItems.Count).SubItems(4) = Format(txtsasia * CCur(!qmimi_shitjes), "###,###,###0.00")
    inttotal1 = Val(txtsasia)
    inttotal2 = Format(CCur(!qmimi_shitjes), "###,###,###0.00")
    inttotal = inttotal1 * inttotal2
    txtsasia = "1"
    txtbarkodi = ""
    lbltotal = Format(CCur(lbltotal) + CCur(inttotal), "###,###,###0.00")
    txtbarkodi.SetFocus
    '***********************************************************
    On Error Resume Next
    LCD_Command (LCD_CLR)
    MSComm1.Output = txbuff
    LCD_Command (LCD_CLR)
    MSComm1.Output = txbuff
    LCD_Command (NEXT_LINE)
    MSComm1.Output = txbuff
    txbuff = !pershkrimi
    txb = !qmimi_shitjes
    MSComm1.Output = "> " & txbuff & "    " & txb
    '===============================================
    Else
    txtbarkodi.Text = ""
    End If
    End With
    End If
    End Sub
    
    Private Sub txtsasia_GotFocus()
    Call SelectAll(txtsasia)
    End Sub
    
    Private Sub txtsasia_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
    picsasia.Visible = False
    End If
    End Sub
    
    Private Sub txtsasia_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
    Command1_Click
    End If
    End Sub
    
    Private Sub txtzbritja_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
    piczbritja.Visible = False
    End If
    End Sub
    
    Private Sub txtzbritja_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
    Command3_Click
    End If
    End Sub
    
    Private Sub txtzbritja2_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
    piczbritja2.Visible = False
    End If
    End Sub
    
    Private Sub txtzbritja2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
    Command2_Click
    End If
    End Sub

  2. #2
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    12,252

    Re: a little help with this code

    To much code to look through, show where the problem is

  3. #3

    Thread Starter
    New Member
    Join Date
    Dec 2017
    Posts
    2

    Re: a little help with this code

    Code:
    Private Sub mnusasia_Click()
    picsasia.Visible = True
    txtsasia.SetFocus
    End Sub
    for example this is the qty code !



    and this is the return code
    Code:
    Private Sub mnukthimi_Click()
    
    End Sub
    i want to make the code when i hit qty to change the qty to something else , like i have it 1 and want to change it to 2 for example
    by changing the quantity it will change the price amount as the qty is more or less

  4. #4
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    12,252

    Re: a little help with this code

    Hmm well there really is no code there, just setting a picture to visible and focus to a text box. Nothing that sets or checks a qty

    That said you said your problem is that when you hit return is does nothing which is expected as there is no code at all in that click event.

  5. #5
    PowerPoster
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    2,511

    Re: a little help with this code

    There are many On Error Resume Next which suppress any error occurs! try to temporary comment all of them to see if there is an error



  6. #6
    Fanatic Member
    Join Date
    Dec 2014
    Posts
    516

    Re: a little help with this code

    -delete-
    Last edited by baka; Dec 3rd, 2017 at 06:17 PM.

  7. #7
    Fanatic Member
    Join Date
    Dec 2014
    Posts
    516

    Re: a little help with this code

    you should not use On Error Resume Next that much. or at all.
    of course you can use it, but should be placed on specific locations that we know for sure theres a possibility for an error that we can not control.
    in this case is just a lazy way to force a bad made program to run.

    so, remove all the On Error, and try to fix all the errors first.

  8. #8
    Fanatic Member
    Join Date
    Dec 2014
    Posts
    516

    Re: a little help with this code

    -delete-

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width