Prikazi cijelu temu 16.07.2012 12:56
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Lokacija:-


Predmet:Iz Å kole VB-a
Evo malo sam prepravio tvoj kod zxz kad čita bar kod iz kojeg čita količinu:
PreuzmiIzvorni kôd (Text):
  1. On Error GoTo Err_SIFART_AfterUpdate
  2. Dim Db As DAO.Database
  3. Dim Rs As DAO.Recordset
  4. Dim BarKod As String, SQL As String
  5.  
  6. BarKod = Trim(Me.SIFART)
  7. Me.Kolicina = 1
  8. Set Db = CurrentDb()
  9. If Left(BarKod, 1) = "2" Then
  10.    If Len(BarKod) < 13 Then
  11.       Me.Kolicina = 1
  12.    Else
  13.       Me.Kolicina = Round(Mid(BarKod, 9, 4) / 1000, 2)
  14.       BarKod = Left(BarKod, 7)
  15.     End If
  16. End If
  17.  
  18. SQL = "SELECT Fsifra,ArtSif,ArtNaz,ArtGrupa,ArtMcije FROM tblArtikli " _
  19.     & "WHERE ArtSif='" & BarKod & "'"
  20. Set Rs = Db.OpenRecordset(SQL)
  21.  
  22. If Rs.RecordCount > 0 Then
  23.     Me.SIFART = Rs!ArtSif
  24.     Me.NazArt = Rs!ArtNaz
  25.     Me.Grupa = Rs!ArtGrupa
  26.     Me.PORPOS = 17
  27.     Me.PORPOS2 = 0
  28.     Me.PORPOS3 = 4
  29.     Me.PRODCIJ = Rs!ArtMCije
  30.     If (Me.StanjeKasa.Visible = True) Then
  31.     Me.StanjeKasa = Round(DLookup("Stanje", "qryStanjeSkladista", "ArtSif='" & Me.SIFART & "' and Skladiste='" & Me.SkladisteKasa & "'"), 2)
  32.     If IsNull(Me.StanjeKasa) Then
  33.     Me.StanjeKasa = "0,00"
  34.     End If
  35.     Else
  36.     End If
  37.     'DoCmd.GoToControl "NAZART"
  38.     Call Command39_Click
  39.     Me.LISTBOX2.Requery
  40. If (Me.StanjeKasa.Visible = True) Then
  41. If (Me.StanjeKasa <= 0) Then
  42. If MsgBox("Sigurno želite izdati veu koli
  43. inu od one koju imate na skladištu: '" & Me.StanjeKasa & "'?", vbQuestion + vbYesNo, "Potvrda Knjiženja") = vbYes Then
  44. Else
  45. DoCmd.SetWarnings False
  46. DoCmd.RunSQL "DELETE FROM STAVKEMP  WHERE BROULIZ='" & Me.BROIZD & "' and BROSTAV='" & Format$(Forms.frmIZLAZMP.BROSTAV - 1, "0000") & "'"
  47. DoCmd.SetWarnings True
  48. Me.StanjeKasa = "0,00"
  49. Me.LISTBOX2.Requery
  50. Me.UKUPNO = DSum("PRODCIJUK", "qrySTAVKEMP", "BROULIZ='" & Me.BROIZD & "' and DATULIZ=#" & Format$(Me.DATIZD, "mm\/dd\/yyyy") & "#")
  51. DoCmd.SetWarnings False
  52. DoCmd.RunSQL "UPDATE GLSTAVKEMP SET IZNOS='" & Me.UKUPNO & "' WHERE BROULIZ='" & Me.BROIZD & "'"
  53. DoCmd.SetWarnings True
  54. If IsNull(DLookup("BROSTAV", "STAVKEMP", "BROULIZ='" & Me.BROIZD & "' and  DATULIZ=#" & Format$(Me.DATIZD, "mm\/dd\/yyyy") & "#")) Then
  55. Me.BROSTAV = Format$("1", "0000")
  56. Else
  57. Me.BROSTAV = Format$((DMax("BROSTAV", "STAVKEMP", "BROULIZ='" & Me.BROIZD & "' and  DATULIZ=#" & Format$(Me.DATIZD, "mm\/dd\/yyyy") & "#")) + 1, "0000")
  58. End If
  59. End If
  60. Else
  61. End If
  62. Else
  63. End If
  64.  
  65. Else
  66.     DoCmd.OpenForm "frmPretrazivanje1"
  67.    
  68. End If
  69. 'DoCmd.GoToControl "SIFART"
  70. Rs.Close
  71. Set Db = Nothing
  72. 'Call POREZ
  73. On Error Resume Next
  74.    
  75. Exit_SIFART_AfterUpdate:
  76.     Exit Sub
  77.  
  78. Err_SIFART_AfterUpdate:
  79.     MsgBox "GreÅ¡ka unosa bar koda pokuÅ¡ajte ponovno!", vbExclamation, "Nepotpun unos"
  80.     Me.SIFART = ""
  81.     Resume Exit_SIFART_AfterUpdate
Imat ću joÅ¡ neÅ¡to u vezi kataloÅ¡kog broja pa ću i to postaviti ali čini mi se da će ovo biti dobro samo moram joÅ¡ to na terenu ispitati,kod mene radi dobro.
Hvala
Miro