-
Dec 3rd, 2017, 10:48 AM
#1
Thread Starter
New Member
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
-
Dec 3rd, 2017, 11:44 AM
#2
Re: a little help with this code
To much code to look through, show where the problem is
-
Dec 3rd, 2017, 11:56 AM
#3
Thread Starter
New Member
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
-
Dec 3rd, 2017, 06:35 PM
#4
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.
-
Dec 3rd, 2017, 07:02 PM
#5
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
-
Dec 3rd, 2017, 07:10 PM
#6
Re: a little help with this code
Last edited by baka; Dec 3rd, 2017 at 07:17 PM.
-
Dec 3rd, 2017, 07:13 PM
#7
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.
-
Dec 3rd, 2017, 07:16 PM
#8
Re: a little help with this code
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|