• DİKKAT

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

Kayıt dosyası

  • Konbuyu başlatan Konbuyu başlatan raaroka
  • Başlangıç tarihi Başlangıç tarihi
Katılım
26 Haziran 2009
Mesajlar
107
Excel Vers. ve Dili
2007
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,
 

Ekli dosyalar

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

Ekli dosyalar

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?
 
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.
 
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
 
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.
 
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
 

Ekli dosyalar

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.
 

Ekli dosyalar

Geri
Üst