• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kaydedilecek Sayfayı Bulamadım,

A

Altay3555

Katılım
13 Haziran 2009
Mesajlar
486
Excel Vers. ve Dili
excel 2007 tr
Private Sub CommandButton1_Click() 'KAYDET TUŞU (Yeni veri girişi için kullanılmaktadır.)
Dim Satır As Long, Say As Byte

Satır = Range("A65536").End(3).Row + 1

If TextBox1.Text = "" Then
MsgBox "Sıra No giriniz !", vbExclamation, "Eksik Bilgi Girişi"
TextBox1.SetFocus
Exit Sub
End If

If TextBox2.Text = "" Then
MsgBox "Adı ve Soyadını Giriniz !", vbExclamation, "Eksik Bilgi Girişi"
TextBox2.SetFocus
Exit Sub
End If

If TextBox3.Text = "" Then
MsgBox "Doğum Tarihi Bilgisini Giriniz !", vbExclamation, "Eksik Bilgi Girişi"
TextBox3.SetFocus
Exit Sub
End If

If TextBox4.Text = "" Then
MsgBox "Kilo Giriniz !", vbExclamation, "Eksik Bilgi Girişi"
TextBox4.SetFocus
Exit Sub
End If


If TextBox5.Text = "" Then
MsgBox "Boy Uzunluğunu Giriniz!", vbExclamation, "Eksik Bilgi Girişi"
TextBox5.SetFocus
Exit Sub
End If

If TextBox6.Text = "" Then
MsgBox "Annenin yaşını Giriniz !", vbExclamation, "Eksik Bilgi Girişi"
TextBox6.SetFocus
Exit Sub
End If


'Mükerrer giriş önleme
Say = WorksheetFunction.CountIf(Range("A7:A65536"), TextBox1.Text)
If Say > 0 Then
MsgBox "Bu kayıt daha önce girilmiştir !" & vbNewLine & _
"Lütfen girdiğiniz bilgileri kontrol ediniz.", vbCritical, "Mükerrer Kayıt"
Exit Sub
End If


'Kayıt işlemi için gerekli bilgileri ilgili hücrelere aktarıyoruz.

Cells(Satır, "A") = Satır - 1
Cells(Satır, "B") = TextBox1.Text
Cells(Satır, "C") = Format(TextBox4.Text, "dd.mm.yyyy")
Cells(Satır, "E") = TextBox4.Text
Cells(Satır, "F") = TextBox5.Text
Cells(Satır, "G") = TextBox5.Text

'4 - Kayıt işleminden sonra verileri ListBox1 nesnesine aktarıyoruz.

'With UserForm_Doğum.ListBox1
'.BackColor = vbYellow
'.ColumnCount = 7
'.ColumnWidths = "20;100;50;30;30;30;30"
'.ForeColor = vbRed
'If Sheets("Dogum").Range("A7") = Empty Then
'.RowSource = Empty
'Else
'.RowSource = "Dogum!B7:G" & [VERİ!A65536].End(3).Row
'End If
'End With
MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"
End Sub

Selamlar..
Yukarıdaki kodlarımda nedense ANA SAYFA nın olduğu Userformları açtığım sayfaya kayıt yapıyor,İstediğim "Dogum" adlı sayfanın 7.sırasından itibaren kayıt yapması,ama 14.sıradan başlıyor nedense.
Kopya kod yazmaktan da zor,hele ki listbox a aktarımı hiç çalıştıramadım WİTH ibaresi hata veriyor.
Dosya ekleyemiyorum çünkü çoklu sayfa ve Userform,bir türlü ayıramadım.
Bir el bekliyorum.
Sevgi ve Saygılarımla.
 
With ile başlayana yere Userformunuzun adı nokta listboxınızın adı şeklinde yazın.:cool:
Satır = sheets("Sayfa_adı").Range("A65536").End(3).Row + 1
sheets("Sayfa_adı").Cells(Satır, "A") = Satır - 1
sheets("Sayfa_adı").Cells(Satır, "B") = TextBox1.Text
'Mükerrer giriş önleme
Say = WorksheetFunction.CountIf(sheets("Sayfa_adı").Range("A7:A65536"), TextBox1.Text)
 
Ben kodları verdim.Neyi bekliyorsunuz bilmiyorum.Sihirli bir değnek deyecek ve olacakmı diye düşünüyorsunuz?Üstelik bir teşekkür bile etmediniz!:cool:
 
Evren Gizlen' Alıntı:
Ben kodları verdim.Neyi bekliyorsunuz bilmiyorum.Sihirli bir değnek deyecek ve olacakmı diye düşünüyorsunuz?Üstelik bir teşekkür bile etmediniz!:cool:
Genişletmek için tıkla ...


Selam Hocam,
Dairedeydim mesajı aldığımda,önce arkadaşa cevap yazdım,size yazdıklarımda teşekkür mesajın ayrılmaz parçasıdır biliyorsunuz,lakin dairede DSL yükseltme problemimize denk gelen 1/2 sayfalık mesaj maalesef yayınlanamadan gitti.
Şimdi de girer girmez cevabınıza teşekkür etmek için geldim.
Size teşekkürlerim yüreğimin taaaaaaaa derinlerinlerinden...
Küçük de olsanız ellerinizden öperim.:)
Saygılar..
 
harziyan' Alıntı:
ah şu dosyayı bi eklesen...
Genişletmek için tıkla ...

Selam
Uyarlanan kodlara bakarsanız sitemizin dershanesinden (ç)ALINTI olduğunu keşfedebilirsiniz.Sayın Korhan Ayhan Hocamın ders notlarından.
benim UserForm bağlantı ve komplike olduğundan gönderemiyorum,Yoksa çok dosya gönderdim.
Sevgiler.
 
Altay3555' Alıntı:
Selam Hocam,
Dairedeydim mesajı aldığımda,önce arkadaşa cevap yazdım,size yazdıklarımda teşekkür mesajın ayrılmaz parçasıdır biliyorsunuz,lakin dairede DSL yükseltme problemimize denk gelen 1/2 sayfalık mesaj maalesef yayınlanamadan gitti.
Şimdi de girer girmez cevabınıza teşekkür etmek için geldim.
Size teşekkürlerim yüreğimin taaaaaaaa derinlerinlerinden...
Küçük de olsanız ellerinizden öperim.:)
Saygılar..
Genişletmek için tıkla ...
Rica ederim.
Saygılar benden.:cool:
 
Evren Gizlen' Alıntı:
With ile başlayana yere Userformunuzun adı nokta listboxınızın adı şeklinde yazın.:cool:
Satır = sheets("Sayfa_adı").Range("A65536").End(3).Row + 1
sheets("Sayfa_adı").Cells(Satır, "A") = Satır - 1
sheets("Sayfa_adı").Cells(Satır, "B") = TextBox1.Text
'Mükerrer giriş önleme
Say = WorksheetFunction.CountIf(sheets("Sayfa_adı").Range("A7:A65536"), TextBox1.Text)
Genişletmek için tıkla ...


Hocam selam,
Hala uğraşıyorum,ama artık stepe geçme zamanı galiba.
Sayfa_Adı dediğiniz yerlere "Dogum" olarak nitelendirdiğim sayfamın adını yazdım,lakin yaprak kımıldamadı,unutmadan
Mükemmel şekilde kaydediyor ama,bu sefer de nereye kaydettiğini bulamıyorum.:)

Satır = Sheets("Dogum").Range("A65536").End(3).Row + 1
Sheets("Dogum").Cells(Satır, "A") = Satır - 1
Sheets("Dogum").Cells(Satır, "B") = TextBox2.Text 'Dogum sayfasında b7 ye kaydedilecek
Sheets("Dogum").Cells(Satır, "C") = TextBox3.Text
Sheets("Dogum").Cells(Satır, "E") = TextBox4.Text
Sheets("Dogum").Cells(Satır, "F") = TextBox5.Text

With UserForm3_Doğum.ListBox1
.BackColor = vbYellow
.ColumnCount = 7
.ColumnWidths = "20;100;50;30;30;30;30"
.ForeColor = vbRed
If Sheets("Dogum").Range("A7") = Empty Then
.RowSource = Empty
Else
.RowSource = "Dogum!B7:G" & [Dogum!A65536].End(3).Row
End If
End With

MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
 
Altay3555' Alıntı:
Hocam selam,
Hala uğraşıyorum,ama artık stepe geçme zamanı galiba.
Sayfa_Adı dediğiniz yerlere "Dogum" olarak nitelendirdiğim sayfamın adını yazdım,lakin yaprak kımıldamadı,unutmadan
Mükemmel şekilde kaydediyor ama,bu sefer de nereye kaydettiğini buşamıyorum.:)

Satır = Sheets("Dogum").Range("A65536").End(3).Row + 1
Sheets("Dogum").Cells(Satır, "A") = Satır - 1
Sheets("Dogum").Cells(Satır, "B") = TextBox2.Text
Sheets("Dogum").Cells(Satır, "C") = TextBox3.Text
Sheets("Dogum").Cells(Satır, "E") = TextBox4.Text
Sheets("Dogum").Cells(Satır, "F") = TextBox5.Text

With UserForm3_Doğum.ListBox1
Genişletmek için tıkla ...
Kod: 
Satır = Sheets("Dogum").Range("A65536").End(3).Row + 1
bu satırın altına msgbox Satır diye kod yazarsanız kaçıncı satıra kaydedildiğini bulursunuz.
Veya VBE'de step and step yaparakta bulabilirsiniz.Step and step nasıl yapılıyor derseniz onu şimdi unuttum.Hatırlamıyorum.:D
 
Selamlar..
Örnek dosya karışık olduğundan ancak dosya içerisinde açıklayabildim.
Acemi işi olmadığından bir karış bile ilerleyemedim.
Step to Step ile başarılabilecek bir eylem ama...
Dilerim çocuk oyuncağıdır.:)
 
Son düzenleme:
Veya VBE'de step and step yaparakta bulabilirsiniz.Step and step nasıl yapılıyor derseniz onu şimdi unuttum.Hatırlamıyorum.:D[/QUOTE]



Bu sizin yolunuz hocam,nasıl unutabilirsiniz ki.Aynen bu şekilde işte.Step59 dan başlıyor,bilahere 59.2
59.22
diye gidiyor.Bizde bu adımları seviyoruz işte..:)
Sevgiler.
 
bu satırın altına msgbox Satır diye kod yazarsanız kaçıncı satıra kaydedildiğini bulursunuz.

MsgBox Satır yazdım..
6 yazdı kaydetti.Ama izini bulamadım yine.:)
Klavyem salak birşey steptostep için F5lerF8ler çalışmıyor.F lerin hiç biri çalışmıyor nedense..
Demek ondan benim kodlar yanlış oluyordur.:(
Selamlar.
 
Kaydediyor.İşte bakın 12nci satırı ben kaydettim.Ayrıca listboxa verileri aldığınız satırda with başlangızcını yanlış yazmışsınız.Aşağıdaki gibi yaptım.Sizin dosyanızda userform3 yokk ki siz userform3 yazmışsınız.:cool:
Kod: 
With UserForm1.ListBox1
 

Ekli dosyalar

Evren Gizlen' Alıntı:
Kaydediyor.İşte bakın 12nci satırı ben kaydettim.Ayrıca listboxa verileri aldığınız satırda with başlangızcını yanlış yazmışsınız.Aşağıdaki gibi yaptım.Sizin dosyanızda userform3 yokk ki siz userform3 yazmışsınız.:cool:
Kod: 
With UserForm1.ListBox1
Genişletmek için tıkla ...

Selam hocam,
örnek dosyada hazırladığım kayıtların altına gayet güzel kayıt yaptı,hatta listbox a bile.İlk sıradaki bebek kaydını bırakıp (sıra no 1),yeni kayıt yaptığımda sıra noyu 2 verdim,kaydet komutundan sonra o bana 7 sıra nosu vererek kaydetirdi.
Diğer denememde ise tüm kayıtları sildim,yeni kayıt yapayım dedim,yapmadı.
Netice de,
Kayıt yokken kayıt yapmıyor,
Bir kayıt varken sıra nosu 1 ise ikinci yaptığım kayıtın sıra nosu 7 den başlıyor.(Kod içerisindeki 7 leri sildim-ki 7.satırdan itibaren kayıtlara başlasın diye yaptım bunu,makina ilk boş satır olayını anlayamayacağını düşündüğümden.)7 leri silmeme rağmen 2 den başlatamadım.
Ne yapayım şimdi ben,
Stepin 2.adımı olarak diğer kodlarımı yavaş yavaş yazıyorum.
Selamlar,


Not olarak.(Benim başlıklardaki konular nedense çok mesaj sonunda çözüme kavuşuyor ve bunlar benden kaynaklanıyor-her ne kadar yarım ve çözümsüz kalan dosyalrım olsa da)
 
Aşağıdaki kodda kaçıncı satırdan başlıyorsanız onun 1 eksiğini satır adlı değişkenden çıkarınçO zaman olur.mesela 7nci satırdan başlıyorsa kayıtlarınız satır - 6 yazın.:cool:
Kod: 
Sheets("Dogum").Cells(Satır, "A") = Satır - 1
 
Evren Gizlen' Alıntı:
Aşağıdaki kodda kaçıncı satırdan başlıyorsanız onun 1 eksiğini satır adlı değişkenden çıkarınçO zaman olur.mesela 7nci satırdan başlıyorsa kayıtlarınız satır - 6 yazın.:cool:
Kod: 
Sheets("Dogum").Cells(Satır, "A") = Satır - 1
Genişletmek için tıkla ...

Hocam,eksiğimi gördüm teşekkürler.
*Veri olmadığı zaman kayıt etmemesinin nedeni ne olabilir.
Selamlar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst