Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Müteselsil Sipariş Numarası Verme

kanakan52
kanakan52
Excel Cevaplanmış Soruları
73
7784

Müteselsil Sipariş Numarası Verme

#19
kanakan52
Aktif Üye
kanakan52
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 41
Konum:
Ofis Versiyonu:
Son Oturumu: 18/07/2022,22:02
Yorumları: 275
Konuları: 29
Kayıt Tarihi: 09/05/2013
Teşekkür Puanı: 0
(05/04/2020, 14:36)berduş yazdı: Belirttiğim gibi çalışmanızı eklerseniz uygun olduğumuzda inceleyip çözmeye çalışırız.


Hocam , ekledim..

Tekrar tekrar teşekkür ederim.
.rar deneme.rar (Dosya Boyutu: 314,84 KB | İndirme Sayısı: 4)
Cevapla
#20
feraz
Uzman
feraz
Bul
Uzman
Adı Soyadı: Za....
Yaşı: 47
Konum: -
Ofis Versiyonu: Diğer
Son Oturumu: 28/07/2024,00:46
Yorumları: 3.642
Konuları: 95
Kayıt Tarihi: 30/03/2013
Teşekkür Puanı: 316
Yanlış anlamış olabilirim.
Kodun mantığı şu;
textboxtan arama apılınca listviewdeki en son veriyi bulur ve 1 fazlasını aktarır.Dedğim gibi tam olmadı başka yoldanda yapılabilir.
Kod:
rs.Open "select * from m_siparis WHERE m_siparis.SIPEMRINO LIKE '" & TextBox1.Text & "%'", baglan, 1, 1
Yukarıdaki koddaki % kaldırdım tekşnş ilk karaktere göre araması için.

İlk kod eklediğim altındaki ise tamamı.
Kod:
If .ListItems.Count < 1 Then
        If Me.TextBox1.Value > "" Then
            TBL_SIPRS.Tsipno.Value = Me.TextBox1.Value & "0000000001"
        Else
            TBL_SIPRS.Tsipno.Value = Empty
        End If
        GoTo son
    End If
   
    aa = .ListItems(.ListItems.Count)
   
    For i = 1 To Len(aa)
        If Not IsNumeric(Mid(aa, i, 1)) Then
            bb = bb & Mid(aa, i, 1)
        Else
            say = i
            Exit For
        End If
    Next
   
    For ii = say To Len(aa)
        If Mid(aa, ii, 1) = 0 Then
            cc = cc & Mid(aa, ii, 1)
        Else
            sayy = ii
            Exit For
        End If
    Next
    dd = bb & cc
   
    For iii = sayy To Len(aa)
        ee = ee & Mid(aa, iii, 1)
    Next
   
    ff = dd & ee + 1
   
End With

TBL_SIPRS.Tsipno.Value = ff
Exit Sub
son:



Kod:
Sub filtresprs()
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
baglan.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\veritabani.mdb"

rs.Open "select * from m_siparis WHERE m_siparis.SIPEMRINO LIKE '" & TextBox1.Text & "%'", baglan, 1, 1

With ListView1
    .ListItems.Clear

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF
        .ListItems.Add , , rs(0).Value & ""
        For i = 1 To rs.Fields.Count - 1
            .ListItems(.ListItems.Count).ListSubItems.Add , , rs(i).Value & ""
        Next i
        rs.MoveNext
    Loop
    End If

    If .ListItems.Count < 1 Then
        If Me.TextBox1.Value > "" Then
            TBL_SIPRS.Tsipno.Value = Me.TextBox1.Value & "0000000001"
        Else
            TBL_SIPRS.Tsipno.Value = Empty
        End If
        GoTo son
    End If
   
    aa = .ListItems(.ListItems.Count)
   
    For i = 1 To Len(aa)
        If Not IsNumeric(Mid(aa, i, 1)) Then
            bb = bb & Mid(aa, i, 1)
        Else
            say = i
            Exit For
        End If
    Next
   
    For ii = say To Len(aa)
        If Mid(aa, ii, 1) = 0 Then
            cc = cc & Mid(aa, ii, 1)
        Else
            sayy = ii
            Exit For
        End If
    Next
    dd = bb & cc
   
    For iii = sayy To Len(aa)
        ee = ee & Mid(aa, iii, 1)
    Next
   
    ff = dd & ee + 1
   
End With

TBL_SIPRS.Tsipno.Value = ff
Exit Sub
son:
Set rs = Nothing
Set con = Nothing
End Sub
Cevapla
#21
kanakan52
Aktif Üye
kanakan52
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 41
Konum:
Ofis Versiyonu:
Son Oturumu: 18/07/2022,22:02
Yorumları: 275
Konuları: 29
Kayıt Tarihi: 09/05/2013
Teşekkür Puanı: 0
feraz hocam günaydın, selamlar,

Gecenin bir yarısı biz uyurken sen bizim sorunlarımızla mı uşraştın, Allah senden razı olsun, her şey gönlünce olsun,

Hocam mantık muhasebe programlarının fatura modülü, irsaliye modülü mantığı aslında. Hani yeni fatura keserken fatura noya tıklayınca sıradaki numarayı atarya, onu sordum aslında..

Kodlarınızı işte olduğumdan deneyemedim, eve geçince seve seve deneyeceğim.

Saygılar..
Cevapla
#22
berduş
Berduş
berduş
Bul
Uzman
Adı Soyadı: ha....
Konum: -
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Bugün,21:23
Yorumları: 8.506
Konuları: 94
Kayıt Tarihi: 30/07/2014
Teşekkür Puanı: 1.051
Tsipno_KeyPress olayını aşağıdaki gibi düzenler misiniz
Private Sub Tsipno_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

On Error Resume Next

Dim Hrf As String

Hrf = Chr(KeyAscii)

KeyAscii = 0

Set baglan = CreateObject("adodb.connection")

Set rs = CreateObject("adodb.recordset")

baglan.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\veritabani.mdb"



SqlMax = "SELECT Max(Right(SiparisKayitlari.Siparis_No,11)) AS Sno FROM SiparisKayitlari WHERE (SiparisKayitlari.Siparis_No) Like '" & _

Hrf & "%'"

rs.Open SqlMax, baglan, adOpenKeyset, adLockPessimistic



rs.MoveFirst

gecici = IIf(IsNull(rs(0)), 1, rs(0) + 1)

Tsipno = Hrf & Format(gecici, "00000000000")

rs.Close

End Sub
Not:baglan.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\veritabani.mdb" bu koddaki 
Microsoft.ACE.OLEDB.12.0; sizde
microsoft.jet.oledb.4.0; olabilir
Cevapla
Star #23
kanakan52
Aktif Üye
kanakan52
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 41
Konum:
Ofis Versiyonu:
Son Oturumu: 18/07/2022,22:02
Yorumları: 275
Konuları: 29
Kayıt Tarihi: 09/05/2013
Teşekkür Puanı: 0
Hocam selamlar,

Cevabınızı görür görmez atladım geldim..

Muhteşem, tam istediğim sonuç.. Emeğinize sağlık, ellerinize, zihninize sağlık.

Ne güzel insanlarsınız yahuu +rep +rep   çok mutlu oldum..
Cevapla
#24
berduş
Berduş
berduş
Bul
Uzman
Adı Soyadı: ha....
Konum: -
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Bugün,21:23
Yorumları: 8.506
Konuları: 94
Kayıt Tarihi: 30/07/2014
Teşekkür Puanı: 1.051
Yalniz dikkat etmeniz gereken 1 nokta var burada sayisal alan 11 haneli olduğu için right fonksiyonunda 11 kullanıldı burada amaç alandan sayisal olmayan alfabetik kısmi çıkarmaktır. Eğer tablodaki alanının yapısı değişirse fonksiyon ona göre yeniden düzenlenmeli
Iyi calismalar
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task