Predmet:Re: Upis u tablicu
U međuvremenu sam uspio prepisivanje rijeÅ¡iti sa dvije funkcije:
PreuzmiIzvorni kôd (vbnet):Function ProknjiziMS_I(ID As String) 'Medjuskladusna otpremnica izlaz
On Error GoTo Err_ProknjiziMS_I
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim Rs4 As Recordset
Dim SQL As String
Dim SQL1 As String
Set rcs = Nothing
Set db = CurrentDb()
SQL = "SELECT * FROM tblDokumenti WHERE ID='" & ID & "'"
SQL1 = "SELECT * FROM tblDokumentiStavke WHERE ID='" & ID & "'"
Set rs1 = db.OpenRecordset(SQL)
Set rs2 = db.OpenRecordset("tblTransakcije")
Set rs3 = db.OpenRecordset(SQL1)
Set Rs4 = db.OpenRecordset("tblUlazIzlaz")
' Upis u tbl_Transakcije
Do While Not rs1.EOF
rs2.AddNew
rs2!Datum = rs1!Datum
rs2!Skladiste = rs1!Skladiste
rs2!IDdokumenta = rs1!IDdokumenta
rs2!BrDokumenta = rs1!ID
rs2!PartnerID = rs1!PartnerID
rs2!OperID = tkoRadiIme() & " " & tkoRadiPrezime()
rs2!StatusTR = 2 'Izlaz
rs2.Update
rs1.MoveNext
Loop
' Upis u Tbl_UlazIzlaz
Do While Not rs3.EOF
Rs4.AddNew
Rs4!IDTransakcije = DLookup("[IDtransakcije]", "TblTransakcije", "[BrDokumenta] ='" & ID & "'And [Skladiste]='" & Skl & "'")
Rs4!Sifra = rs3!Sifra
Rs4!Izlaz = rs3!Kolicina
Rs4.Update
rs3.MoveNext
Loop
rs3.Close
Rs4.Close
Set db = Nothing
Izlaz:
Exit Function
Err_ProknjiziMS_I:
MsgBox "Greska broj " & err.Number & vbCrLf & err.Description & vbCrLf & "u funkciji ProknjiziMS()"
Kraj:
MsgBox "Niste popunili sve podatke"
End Function
i
PreuzmiIzvorni kôd (vbnet):Function ProknjiziMS_U(ID As String) 'Medjuskladusna otpremnica ulaz
On Error GoTo Err_ProknjiziMS_U
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim Rs4 As Recordset
Dim SQL As String
Dim SQL1 As String
Set rcs = Nothing
Set db = CurrentDb()
SQL = "SELECT * FROM tblDokumenti WHERE ID='" & ID & "'"
SQL1 = "SELECT * FROM tblDokumentiStavke WHERE ID='" & ID & "'"
Set rs1 = db.OpenRecordset(SQL)
Set rs2 = db.OpenRecordset("tblTransakcije")
Set rs3 = db.OpenRecordset(SQL1)
Set Rs4 = db.OpenRecordset("tblUlazIzlaz")
' Upis u tbl_Transakcije
Do While Not rs1.EOF
rs2.AddNew
rs2!Datum = rs1!Datum
rs2!Skladiste = rs1!Skladiste_2
rs2!IDdokumenta = rs1!IDdokumenta
rs2!BrDokumenta = rs1!ID
rs2!PartnerID = rs1!PartnerID
rs2!OperID = tkoRadiIme() & " " & tkoRadiPrezime()
rs2!StatusTR = 1 'Ulaz
rs2.Update
rs1.MoveNext
Loop
' Upis u Tbl_UlazIzlaz
Do While Not rs3.EOF
Rs4.AddNew
Rs4!IDTransakcije = DLookup("[IDtransakcije]", "TblTransakcije", "[BrDokumenta] ='" & ID & "'And [Skladiste]='" & Skl & "'")
Rs4!Sifra = rs3!Sifra
Rs4!Ulaz = rs3!Kolicina
Rs4.Update
rs3.MoveNext
Loop
rs3.Close
Rs4.Close
Set db = Nothing
MsgBox "Stavke sa Dokumenta broj: " _
& Format(IDdokumenta, "00-00000") & " su knjižene!", vbOKOnly, "Potvrda"
Izlaz:
Exit Function
Err_ProknjiziMS_U:
MsgBox "Greska broj " & err.Number & vbCrLf & err.Description & vbCrLf & "u funkciji ProknjiziMS()"
Kraj:
MsgBox "Niste popunili sve podatke"
End Function
Razlika u ove dvije funkcije je u
22 redu rs2!Skladiste - prvi puta je rs1!Skladiste, a drugi puta je rs1!Skladiste_2
27 red rs2!StatusTR prvi puba je 1, a drugi puta 2
Ja sam mislio da ovo bude sve u jednoj funkciji ali i ovo mi odradi posao.
Ove funkcije pozivam sa dugmeta
Private Sub Command63_Click()
ProknjiziMS_I Me.ID
ProknjiziMS_U Me.ID
Me.Proknjizeno = 1
Me.Box66.BackColor = 65408
End Sub
Ali ima tu joÅ¡ jedan problem u slučaju neke greÅ¡ke kod kod izvrÅ¡avanja ovih funkcija, podaci se ne prepiÅ¡u ali se odradi naredba na dugmetu
Me.Proknjizeno = 1
Me.Box66.BackColor = 65408
Kako ovo spriječiti?
Pozdrav