Kayıt dosyası

[raaroka]

Merhaba arkadaşlar.
Küçük bir kayıt programı yapmak istiyorum.
Ekte dosyamı paylaşıyorum ve yardımlarınızı bekliyorum.

Yazdığınız kodları azda olsa açıklarsanız sevinirim. Başka bir yerdede kullanma şansımız olsun en azından bizlerinde. Teşekkürler,

 

[raaroka]

yardım edebilecek kimse ykmu arkadaşlar?

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[raaroka]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Üstadım ellerine sağlık kesinlikle harika olmuş. Son bir şey daha sorsam ,
Kayıt sayfasını temizlemek istersem şifreyi nereden gireceğim ve sileceğim

Birde şifreyi değiştirmek istersem nereden değiştirebilirim?

 

[muygun]

Merhaba;
Kayıt Girişi sayfasının kod bölümünde (ALT+F11 tuşlarına basarak kod bölümüne geçebilirsiniz);

Sub kaydet()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("Kayıt Girişi")
Set s2 = ThisWorkbook.Worksheets("kayıt")
Sheets("kayıt").Unprotect Password:="raaroka"
If s1.Cells(9, 2) <> "" And s1.Cells(9, 3) <> "" And s1.Cells(9, 4) <> "" Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = s1.Cells(9, 2)
s2.Cells(sonsatir, 2) = s1.Cells(9, 3)
s2.Cells(sonsatir, 3) = s1.Cells(9, 4)
Sheets("Kayıt Girişi").Range("b9:d9").ClearContents
Range("B9").Select
MsgBox "İşlem TAMAM.", vbInformation
End If
Sheets("kayıt").Protect Password:="raaroka"
Application.ScreenUpdating = True
End Sub

Kodlar var. Şifreyi burdaki;
Sheets("kayıt").Unprotect Password:="raaroka"
ve
Sheets("kayıt").Protect Password:="raaroka"

satırlarındaki raaroka yazılarını değiştirerek yapabilirsiniz.

kayıt sayfasını silmek için;
Araçlar>koruma dan şifreyi girerek sayfa korumasını kaldırır, sayfayı temizlersiniz.
veya;
kodlardaki;
Sheets("kayıt").Protect Password:="raaroka"
satırının önüne rem yazın ve bir kayıt yapın. (bu işlem mevcut korumayı kaldırır ama tekrar koruma işlemi yapmaz) Böylece sayfayı temizler ve tekrar rem yazısını silerek şifreli konumda çalışmaya devam edebilirsiniz.
İyi çalışmalar.

 

[raaroka]

Merhaba;
Kayıt Girişi sayfasının kod bölümünde (ALT+F11 tuşlarına basarak kod bölümüne geçebilirsiniz);

Sub kaydet()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("Kayıt Girişi")
Set s2 = ThisWorkbook.Worksheets("kayıt")
Sheets("kayıt").Unprotect Password:="raaroka"
If s1.Cells(9, 2) <> "" And s1.Cells(9, 3) <> "" And s1.Cells(9, 4) <> "" Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = s1.Cells(9, 2)
s2.Cells(sonsatir, 2) = s1.Cells(9, 3)
s2.Cells(sonsatir, 3) = s1.Cells(9, 4)
Sheets("Kayıt Girişi").Range("b9:d9").ClearContents
Range("B9").Select
MsgBox "İşlem TAMAM.", vbInformation
End If
Sheets("kayıt").Protect Password:="raaroka"
Application.ScreenUpdating = True
End Sub

Kodlar var. Şifreyi burdaki;
Sheets("kayıt").Unprotect Password:="raaroka"
ve
Sheets("kayıt").Protect Password:="raaroka"

satırlarındaki raaroka yazılarını değiştirerek yapabilirsiniz.

kayıt sayfasını silmek için;
Araçlar>koruma dan şifreyi girerek sayfa korumasını kaldırır, sayfayı temizlersiniz.
veya;
kodlardaki;
Sheets("kayıt").Protect Password:="raaroka"
satırının önüne rem yazın ve bir kayıt yapın. (bu işlem mevcut korumayı kaldırır ama tekrar koruma işlemi yapmaz) Böylece sayfayı temizler ve tekrar rem yazısını silerek şifreli konumda çalışmaya devam edebilirsiniz.
İyi çalışmalar.

Üstadım kodu kendi dosyama göre düzenledim. Fakat kayıt sayfasında sadece A2+B2+C3 hücrelerine yazıyor kaydedilecek veriyi. Normalde N3 e kadar bütün veriyi doldurmalı. Kodun neresinde hata yapıyorum.



Sub kaydet()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("Kayıt Girişi")
Set s2 = ThisWorkbook.Worksheets("kayıt")
Sheets("kayıt").Unprotect Password:="raaroka"
If s1.Cells(2, 1) <> "" And s1.Cells(2, 2) <> "" And s1.Cells(2, 3) <> "" And s1.Cells(2, 4) <> "" And s1.Cells(2, 5) <> "" And s1.Cells(2, 6) <> "" And s1.Cells(2, 7) <> "" And s1.Cells(2, 8) <> "" And s1.Cells(2, 9) <> "" And s1.Cells(2, 10) <> "" And s1.Cells(2, 11) <> "" And s1.Cells(2, 12) <> "" And s1.Cells(2, 13) <> "" And s1.Cells(2, 14) <> "" Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = s1.Cells(2, 1)
s2.Cells(sonsatir, 2) = s1.Cells(2, 2)
s2.Cells(sonsatir, 3) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(2, 4)
s2.Cells(sonsatir, 3) = s1.Cells(2, 5)
s2.Cells(sonsatir, 3) = s1.Cells(2, 6)
s2.Cells(sonsatir, 3) = s1.Cells(2, 7)
s2.Cells(sonsatir, 3) = s1.Cells(2, 8)
s2.Cells(sonsatir, 3) = s1.Cells(2, 9)
s2.Cells(sonsatir, 3) = s1.Cells(2, 10)
s2.Cells(sonsatir, 3) = s1.Cells(2, 11)
s2.Cells(sonsatir, 3) = s1.Cells(2, 12)
s2.Cells(sonsatir, 3) = s1.Cells(2, 13)
s2.Cells(sonsatir, 3) = s1.Cells(2, 14)
Sheets("Kayıt Girişi").Range("a2:n2").ClearContents
Range("A2").Select
MsgBox "İşlem Tamamlanmıştır.", vbInformation
End If
Sheets("kayıt").Protect Password:="raaroka"
Application.ScreenUpdating = True
End Sub

 

[muygun]

Merhaba;
kodlarınızda
s2.Cells(sonsatir, 3) = s1.Cells(2, 4)
kısmında (sonsatir,4) ve 5,6,7... diye artırın. (bu yazılacak sütun no'sudur)
İyi çalışmalar.

 

[raaroka]

Merhaba;
kodlarınızda
s2.Cells(sonsatir, 3) = s1.Cells(2, 4)
kısmında (sonsatir,4) ve 5,6,7... diye artırın. (bu yazılacak sütun no'sudur)
İyi çalışmalar.

Kaydı o şekilde düzelttim ama sanırım başka bir yerde kaçırdığım bir şey var. Dosyayı ekledim. Yardımınızı bekliyorum

 

[muygun]

Kaydı o şekilde düzelttim ama sanırım başka bir yerde kaçırdığım bir şey var. Dosyayı ekledim. Yardımınızı bekliyorum

Merhaba;
Eki deneyin.
İyi çalışmalar.