Skip to main content

AccessTr.neT


Metin Kutusu

metınaycıcek
metınaycıcek
35
4661

Metin Kutusu

#4
"FazlaDagit()" fonksiyonu değiştirildi , en alttaki kod işinize yarayabilir
Dim SqlFazla, SqlBorc, txtKimlik, SqlGuncelle, txtNot As String '<-- "txtNot" eklendi
txtNot = CStr(Date) & " tarihinde verilen " & txtVerilen & " TL""den " & dblx & " TL ödendi " ' '<-- Bu satır  eklendi
                          " OdenenTar=cdate(" & CLng(Date) & "), " & _  '<-- Bu satır değişti
                          " Not='" & txtNot & _  '<-- Bu satır  eklendi

Sub FazlaDagit(Optional Kimlik As String = "") 

Dim Fazla As New ADODB.Recordset
Dim BORC As New ADODB.Recordset
Dim SqlFazla, SqlBorc, txtKimlik, SqlGuncelle, txtNot As String '<-- "txtNot" eklendi
Dim dblBakiye, dblBorc As Double
txtKimlik = IIf(Kimlik = "", "", "  AND ((TBLUYEGENELBIL.KIMID)=" & Kimlik & ")")



SqlFazla = " SELECT TBLUYEGENELBIL.KIMID, TBLUYEGENELBIL.KalanPara" & _
          " FROM TBLUYEGENELBIL " & _
          " WHERE (((TBLUYEGENELBIL.KalanPara)>0)" & txtKimlik & ")"

Fazla.Open SqlFazla, CurrentProject.Connection, adOpenKeyset, adLockOptimistic 'burada açtığın bağlantı

            If Fazla.RecordCount <= 0 Then GoTo 10 ' goto 10 ile kapanmadan
            Fazla.MoveLast
            Fazla.MoveFirst
            Do Until Fazla.EOF
                dblBakiye = 0
                dblBakiye = Fazla.Fields("KalanPara")
                SqlBorc = " SELECT TBLUYEODEMETABLOSU.KIMID, TBLUYEODEMETABLOSU.sira, TBLUYEODEMETABLOSU.TaksitMik, TBLUYEODEMETABLOSU.OdemeMik " & _
                          " FROM TBLUYEODEMETABLOSU " & _
                          " WHERE (((TBLUYEODEMETABLOSU.OdemeMik) < TBLUYEODEMETABLOSU.TaksitMik) And ((TBLUYEODEMETABLOSU.KIMID) =" & Fazla.Fields("KIMID") & ")) " & _
                          " ORDER BY TBLUYEODEMETABLOSU.SonOdemeTar"
                 
                  BORC.Open SqlBorc, CurrentProject.Connection, adOpenKeyset, adLockOptimistic 'burada açtığın bağlantı
                  If BORC.RecordCount <= 0 Then GoTo 20 ' goto 10 ile kapanmadan
                  BORC.MoveLast
                  BORC.MoveFirst
    '
              Do Until BORC.EOF
                    If dblBakiye <= 0 Then GoTo 20
                    dblBorc = 0
                    dblBorc = BORC.Fields("TaksitMik") - BORC.Fields("OdemeMik") 'ödenmesi gereken
                    dblx = IIf(dblBakiye >= dblBorc, dblBorc, dblBakiye)
                    dblBakiye = dblBakiye - dblx

txtNot = CStr(Date) & " tarihinde verilen " & txtVerilen & " TL""den " & dblx & " TL ödendi "
                    SqlGuncelle = " update TBLUYEODEMETABLOSU set " & _
                          " OdemeMik=OdemeMik + ccur('" & dblx & "'), " & _
                          " OdenenTar=cdate(" & CLng(Date) & "), " & _
                          " Not='" & txtNot & _
                          "' where sira=" & BORC.Fields("sira")
                    CurrentDb.Execute SqlGuncelle
                   
                    SqlGuncelle = " update TBLUYEGENELBIL set " & _
                          " KalanPara=KalanPara - ccur('" & dblx & "') " & _
                          " where KIMID=" & Fazla.Fields("KIMID")
                    CurrentDb.Execute SqlGuncelle
           
             
             
              BORC.MoveNext
              Loop

20    '
                BORC.Close
                Set BORC = Nothing
            Fazla.MoveNext
            Loop
10
Fazla.Close
Set Fazla = Nothing
End Sub
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Metin Kutusu - Yazar: metınaycıcek - 12/09/2019, 02:43
RE: Metin Kutusu - Yazar: berduş - 12/09/2019, 11:41
RE: Metin Kutusu - Yazar: metınaycıcek - 12/09/2019, 22:00
RE: Metin Kutusu - Yazar: ozanakkaya - 12/09/2019, 12:01
Re: Metin Kutusu - Yazar: berduş - 12/09/2019, 13:46
Cvp: Metin Kutusu - Yazar: berduş - 12/09/2019, 22:23
RE: Metin Kutusu - Yazar: metınaycıcek - 12/09/2019, 22:27
Cvp: Metin Kutusu - Yazar: berduş - 12/09/2019, 22:29
RE: Metin Kutusu - Yazar: metınaycıcek - 12/09/2019, 22:32
RE: Metin Kutusu - Yazar: metınaycıcek - 12/09/2019, 22:47
RE: Metin Kutusu - Yazar: berduş - 13/09/2019, 00:50
RE: Metin Kutusu - Yazar: metınaycıcek - 13/09/2019, 01:24
Cvp: Metin Kutusu - Yazar: berduş - 13/09/2019, 01:31
RE: Metin Kutusu - Yazar: metınaycıcek - 13/09/2019, 01:40
Cvp: Metin Kutusu - Yazar: berduş - 13/09/2019, 01:45
RE: Metin Kutusu - Yazar: metınaycıcek - 13/09/2019, 01:50
Cvp: Metin Kutusu - Yazar: berduş - 13/09/2019, 01:54
RE: Metin Kutusu - Yazar: metınaycıcek - 13/09/2019, 01:58
Cvp: RE: Metin Kutusu - Yazar: metınaycıcek - 15/09/2019, 22:54
RE: Metin Kutusu - Yazar: metınaycıcek - 13/09/2019, 02:09
Cvp: Metin Kutusu - Yazar: berduş - 15/09/2019, 23:18
Cvp: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 00:29
Cvp: Metin Kutusu - Yazar: berduş - 16/09/2019, 00:50
Cvp: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 02:12
Cvp: Metin Kutusu - Yazar: berduş - 16/09/2019, 10:46
RE: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 12:54
Cvp: Metin Kutusu - Yazar: berduş - 16/09/2019, 13:00
RE: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 13:47
Cvp: Metin Kutusu - Yazar: berduş - 16/09/2019, 15:02
RE: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 17:16
RE: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 17:22
RE: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 23:17
Cvp: Metin Kutusu - Yazar: berduş - 16/09/2019, 23:19
RE: Metin Kutusu - Yazar: metınaycıcek - 16/09/2019, 23:22
Cvp: Metin Kutusu - Yazar: HORZUM - 25/10/2019, 16:33
Cvp: Metin Kutusu - Yazar: metınaycıcek - 26/10/2019, 00:06