Dershane Kayıt Form / program

[serul]

Çekinceniz nedir Bülent Bey ?
Bulunduğumuz ay Aralık olmasına rağmen taksitleri Şubat ayından başlatıyor 

[Bülent Öztürk]

Söylediklerimi unutun ve kodları şu şekilde değiştirin:

Private Sub KAYDT_Click()
Dim say As Long
Dim taksitler As Integer
Dim bugun As Date, sonrakiay As Date

say = ThisWorkbook.Worksheets("DATA").Range("A65530").End(xlUp).Row + 1
ThisWorkbook.Worksheets("DATA").Range("A" & say) = TextBox2 ' VELİ ADI
ThisWorkbook.Worksheets("DATA").Range("B" & say) = TextBox1 ' ÖĞRENCİ ADI
ThisWorkbook.Worksheets("DATA").Range("C" & say) = TextBox3 ' VELİ CEP TEL
ThisWorkbook.Worksheets("DATA").Range("D" & say) = TextBox4 ' VELİ EV TEL
ThisWorkbook.Worksheets("DATA").Range("E" & say) = ComboBox1 ' SINIFI
ThisWorkbook.Worksheets("DATA").Range("F" & say) = CDbl(Label6) * 1 ' TUTAR
ThisWorkbook.Worksheets("DATA").Range("G" & say) = CDbl(ComboBox2) * 1 ' TAKSİT ADEDİ
ThisWorkbook.Worksheets("DATA").Range("H" & say) = CDbl(AYLIK.Caption) * 1 ' TAKSİT TUTARI
'Ocak 2011 - J sütunundan (10.sütun) başlıyor... Ödemeler kayıt tarihinden 1 ay sonra başlayacak...
bugun = VBA.Now
sonrakiay = DateAdd("m", 1, bugun) ' Bugünkü ay'a 1 ekle
hangiay = VBA.Month(sonrakiay)
hangiyil = VBA.Year(sonrakiay)
If hangiay = 12 Then hangiyil = hangiyil + 1
tarihbul = DateSerial(hangiyil, hangiay, 1)
baslangic_bul = Worksheets("DATA").Range("A1:IV1").Find(tarihbul).Column
For taksitler = 0 To CDbl(ComboBox2) - 1
ThisWorkbook.Worksheets("DATA").Cells(say, baslangic_bul + taksitler) = CDbl(AYLIK.Caption) * 1
Next taksitler
MsgBox "Kayıt yapıldı.", vbInformation, Application.UserName
End Sub

[serul]

Üstad harika oldu !
(textox3 ve textbox4 e yazı yazmak istediğimde run-time error 5 hatası veriyor sadece).
Çok uç bir istekmi olur bilmiyorum affına sığınarak sormak istiyorum ;
Gruplar kısmında seçilen sınıflara kapasite (kontenjan) sütunu eklemiştim. Kayıt yapıldıkça bu kontenjan eksilse kontenjan 0(sıfır) olduğunda kontenjan dolu mesajı veya ekranda bu sınıf doludur uyarısı belirtebilir miyiz ?
Listbox oluşturdum taksitleri bu alanda da gösterebilir miyim?

[Bülent Öztürk]

Ne yazdınız da hata verdi?

[Bülent Öztürk]

Gruplar kısmında seçilen sınıflara kapasite (kontenjan) sütunu eklemiştim. Kayıt yapıldıkça bu kontenjan eksilse kontenjan 0(sıfır) olduğunda kontenjan dolu mesajı veya ekranda bu sınıf doludur uyarısı belirtebilir miyiz ?

Yeni bir label ekleyin ve adını lblKontenjan yapın.

ComboBox1 kodlarınızı aşağıdaki şekilde yazın:

Kod: [Seç]

Private Sub ComboBox1_Change()
If ComboBox1 = Empty Then Exit Sub
Dim acilan_kontenjan As Integer, satilan_kontenjan As Integer
satilan_kontenjan = 0
Label6.Caption = ComboBox1.List(ComboBox1.ListIndex, 1)
acilan_kontenjan = Val(WorksheetFunction.VLookup(ComboBox1.Text, Worksheets("GRUPLAR").Range("A2:C20"), 3, 0))
On Error Resume Next
satilan_kontenjan = Val(WorksheetFunction.CountIf(Worksheets("DATA").Range("E2:E20"), ComboBox1.Text))
lblKontenjan.Caption = Val(acilan_kontenjan - satilan_kontenjan)
If CDbl(lblKontenjan.Caption) = 0 Then MsgBox "Bu sınıf doludur!", vbCritical, "İşlem yapılamaz!": ComboBox1 = Empty
End Sub

[serul]

Ne yazdınız da hata verdi?

Rakam yerine yazı yazmak istediğimde hata aldım. Veli ve Öğrenci isimleri için rakam yazmamı zaten kabul etmiyor. O kısım oldu.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[Bülent Öztürk]

Rakam yerine yazı yazmak istediğimde hata aldım. Veli ve Öğrenci isimleri için rakam yazmamı zaten kabul etmiyor. O kısım oldu.

Telefon numaraları rakam değil mi?
Rakam ve harf girmek isterseniz daha önceki kısıtlama kodunu silmeniz yeterlidir.

[serul]

Bu formu kullanacak arkadaşın olası yanlışlıklarına bir nebze önlem almak için kısıtlamaları yazdık. İsimlerin olacağı yere rakam istesede giremiyor. Rakam yazması gereken telefon numaraları yerinede yazı giremesin istiyorum. Yazı girmek istediğinde yazamasın. Şuan için yazı yazmak istediğinde run-time error 5 hatası veriyor. Bu hatanın peşine "End" yerine "Debug" tuşuna bastığını düşünün evlere şenlik artık

[Bülent Öztürk]

Bende hata vermiyor.

Kodların başına aşağıdaki satırı ekler misiniz;

Kod: [Seç]

On error resume next
Bu şekilde hata vermeden devam edecektir.

[serul]

Bülent Bey aşağıdaki kod taksitleri satıra sıralıyor. Yazıcı sayfası oluşturmaya çalışıyorum. Bu taksitleri herhangi bir sayfaya aynı sütunun altına sıralamaya çalışıyorum.Satırın ne olduğunu bir türlü bulamıyorum. Ne yapmalıyım ?

Kod: [Seç]

Private Sub KAYDT_Click()
Dim say As Long
Dim taksitler As Integer
Dim bugun As Date, sonrakiay As Date

say = ThisWorkbook.Worksheets("DATA").Range("A65530").End(xlUp).Row + 1
ThisWorkbook.Worksheets("DATA").Range("A" & say) = TextBox2 ' VELİ ADI
ThisWorkbook.Worksheets("DATA").Range("B" & say) = TextBox1 ' ÖĞRENCİ ADI
ThisWorkbook.Worksheets("DATA").Range("C" & say) = TextBox3 ' VELİ CEP TEL
ThisWorkbook.Worksheets("DATA").Range("D" & say) = TextBox4 ' VELİ EV TEL
ThisWorkbook.Worksheets("DATA").Range("E" & say) = ComboBox1 ' SINIFI
ThisWorkbook.Worksheets("DATA").Range("F" & say) = CDbl(Label6) * 1 ' TUTAR
ThisWorkbook.Worksheets("DATA").Range("G" & say) = CDbl(ComboBox2) * 1 ' TAKSİT ADEDİ
ThisWorkbook.Worksheets("DATA").Range("H" & say) = CDbl(AYLIK.Caption) * 1 ' TAKSİT TUTARI
'Ocak 2011 - J sütunundan (10.sütun) başlıyor... Ödemeler kayıt tarihinden 1 ay sonra başlayacak...
bugun = VBA.Now
sonrakiay = DateAdd("m", 1, bugun) ' Bugünkü ay'a 1 ekle
hangiay = VBA.Month(sonrakiay)
hangiyil = VBA.Year(sonrakiay)
If hangiay = 12 Then hangiyil = hangiyil + 1
tarihbul = DateSerial(hangiyil, hangiay, 1)
baslangic_bul = Worksheets("DATA").Range("A1:IV1").Find(tarihbul).Column
For taksitler = 0 To CDbl(ComboBox2) - 1
ThisWorkbook.Worksheets("DATA").Cells(say, baslangic_bul + taksitler) = CDbl(AYLIK.Caption) * 1
Next taksitler
MsgBox "Kayıt yapıldı.", vbInformation, Application.UserName
End Sub

[Bülent Öztürk]

Yazıcıya göndermek için bir sayfa tasarlayın.
Başlıkları oluşturun, veri alanlarını boş bırakın.
Her kayıtta verileri yazdırılacak sayfadaki ilgili yerlere de atıp, yazıcıya gönderebilirsiniz.

[serul]

Form içerisinde bunu yaptıramıyorum. Senet sayfasını ayrıca açmadan yazdırmak istiyorum.

Kod: [Seç]

Private Sub Yazdir_Click()
Dim say As Long
Dim taksitler As Integer
Dim bugun As Date, sonrakiay As Date

say = ThisWorkbook.Worksheets("DATA").Range("A65530").End(xlUp).Row + 1
ThisWorkbook.Worksheets("SENET").Range("A1") = TextBox2 ' VELİ ADI
ThisWorkbook.Worksheets("SENET").Range("A2") = TextBox1 ' ÖĞRENCİ ADI
ThisWorkbook.Worksheets("SENET").Range("A3") = TextBox3 ' VELİ CEP TEL
ThisWorkbook.Worksheets("SENET").Range("A4") = TextBox4 ' VELİ EV TEL
ThisWorkbook.Worksheets("SENET").Range("A5") = ComboBox1 ' SINIFI
ThisWorkbook.Worksheets("SENET").Range("A6") = CDbl(Label6) * 1 ' TUTAR
ThisWorkbook.Worksheets("SENET").Range("A7") = CDbl(ComboBox2) * 1 ' TAKSİT ADEDİ
ThisWorkbook.Worksheets("SENET").Range("A8") = CDbl(AYLIK.Caption) * 1 ' TAKSİT TUTARI
'Ocak 2011 - A sütunundan (1.sütun) başlıyor... Ödemeler kayıt tarihinden 1 ay sonra başlayacak...
bugun = VBA.Now
sonrakiay = DateAdd("m", 1, bugun) ' Bugünkü ay'a 1 ekle
hangiay = VBA.Month(sonrakiay)
hangiyil = VBA.Year(sonrakiay)
If hangiay = 12 Then hangiyil = hangiyil + 1
tarihbul = DateSerial(hangiyil, hangiay, 1)
baslangic_bul = Worksheets("SENET").Range("A20:S20").Find(tarihbul).Column
For taksitler = 0 To CDbl(ComboBox2) - 1
ThisWorkbook.Worksheets("SENET").Cells(say, baslangic_bul + taksitler) = CDbl(AYLIK.Caption) * 1
Next taksitler
MsgBox "TAMAM", vbInformation, Application.UserName
End Sub
Bu bilgilerle taksitler aynı satırda yan yana geliyor. Ben A20 den sonrasına senetleri A21,A22,... yazdırabilmem için

Kod: [Seç]

say = ThisWorkbook.Worksheets("DATA").Range("A65530").End(xlUp).Row + 1

Kod: [Seç]

baslangic_bul = Worksheets("SENET").Range("A20:S20").Find(tarihbul).Columnbu kodlardan hangisinde nereyi değiştirmeliyim ?

[Bülent Öztürk]

Tam nasıl bir şey yapmak istediğinizi anlayamadım ama şöyle açıklayayım:

DATA isimli sayfanın A sütunu 65530. satırından yukarıya doğru giderek ilk dolu satırın bulunması ve buna 1 eklenip altındaki boş satırın bulunması kodu:

say = ThisWorkbook.Worksheets("DATA").Range("A65530").End(xlUp).Row + 1

Kısaca; kayıt için yukarıdan aşağı ilk boş satırı buluyoruz.

Aynı şekilde SENET sayfası için de şu şekilde kullanabiliriz:

Kod: [Seç]

say = ThisWorkbook.Worksheets("SENET").Range("A65530").End(xlUp).Row + 1
Kayıtları da alt alta göndermek için:
ThisWorkbook.Worksheets("SENET").Range("A" & say) = TextBox2 ' VELİ ADI
ThisWorkbook.Worksheets("SENET").Range("A" & say+1) = TextBox1 ' ÖĞRENCİ ADI
ThisWorkbook.Worksheets("SENET").Range("A" & say+2) = TextBox3 ' VELİ CEP TEL
' ... şeklinde devam edecek...

İlk boş satırı, say değişkenine atayıp, ilgili hücreye veri gönderebiliriz.
Sonraki alanları birer alta yazdırmak için say değişkenine sırayla; 1, 2, 3 vs. ekleriz...
Yani,
Range("A" & say) --> A2 hücresine denk gelirse
Range("A" & say+1) --> A3 hücresine denk gelir
Range("A" & say+2) --> A4 hücresine denk gelir.

[serul]

Bülent Bey gözümün önünde bir yerde ama bulamadım yerini. Bulamadım birde siz bakar mısınız ?

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[Bülent Öztürk]

Neyi bulamadınız, anlamadım?