Kayıt başarılı olduğunda c:\kayit.xls ye bilgi kaydı

[desk]

Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
sifre = InputBox("KAYIT İÇİN ŞİFRE GİRMELİSİNİZ", _
"Yetkili Kişi", "Kaydetmek İçin Şifre girin")
If sifre = "123456" Then
MsgBox "Kayıt işlemi tamamlandı", vbInformation, _
"KAYIT BAŞARILI OLDU"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & _
"Dosya kaydedilemedi", vbCritical, "Hatalı Şifre Girdiniz"
Cancel = True
End If
End Sub

Kodda kaydet tuşunu kullanabildiğinde şifreyi geçtiğinde c:\kayit.xls nin içine kayıt eden pc adı tarih ve saatini nasıl yazdırabilirim.!

 

[halit3]

aşağıda düzeltilmiştir

 

[desk]

hata veriyor.
Call GetComputerName(BilgiAdi, 64)

 

[halit3]

aşağıda düzeltildi

 

[ozgretmen]

Dosyayı inceler misin ?

Sub kaydet()
sifre = InputBox("KAYIT İÇİN ŞİFRE GİRMELİSİNİZ", _
"Yetkili Kişi", "Kaydetmek İçin Şifre girin")
If sifre = "123456" Then
Workbooks.Open Filename:="C:\kayit.xls"
satir = [A65536].End(3).Row + 1
Cells(satir, "A") = Mid(Environ(5), WorksheetFunction.Find("=", Environ(5)) + 1, Len(Environ(5)))
Cells(satir, "B") = Now
ActiveWorkbook.Save
Windows("Kitap1.xls").Activate ' Kendi Dosyanızın İsmini Yazınız...
Windows("kayit.xls").Close
MsgBox "Kayıt işlemi tamamlandı", vbInformation, _
"KAYIT BAŞARILI OLDU"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & _
"Dosya kaydedilemedi", vbCritical, "Hatalı Şifre Girdiniz"
Cancel = True
End If
End Sub

 

[desk]

kayit başarılı olduğunda kayit.xls ye kayıt atmıyor.

 

[halit3]

aşağıda düzeltildi

 

[ozgretmen]

Bu kodu eğer aşağıdaki prosedür içine yazar iseniz butona gerek kalmaz.

Private Sub Workbook_BeforeSave (ByVal SaveAsUI As Boolean, Cancel As Boolean)
sifre = InputBox("KAYIT İÇİN ŞİFRE GİRMELİSİNİZ", _
"Yetkili Kişi", "Kaydetmek İçin Şifre girin")
If sifre = "123456" Then
Workbooks.Open Filename:="C:\kayit.xls"
satir = [A65536].End(3).Row + 1
Cells(satir, "A") = Mid(Environ(5), WorksheetFunction.Find("=", Environ(5)) + 1, Len(Environ(5)))
Cells(satir, "B") = Now
ActiveWorkbook.Save
Windows("Kitap1.xls").Activate ' Kendi Dosyanızın İsmini Yazınız...
Windows("kayit.xls").Close
MsgBox "Kayıt işlemi tamamlandı", vbInformation, _
"KAYIT BAŞARILI OLDU"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & _
"Dosya kaydedilemedi", vbCritical, "Hatalı Şifre Girdiniz"
Cancel = True
End If
End Sub

 

[desk]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
sifre = InputBox("KAYIT İÇİN ŞİFRE GİRMELİSİNİZ", _
"Yetkili Kişi", "Kaydetmek İçin Şifre girin")
If sifre = "123456" Then
Workbooks.Open Filename:="C:\kayit.xls"
satir = [A65536].End(3).Row + 1
Cells(satir, "A") = Mid(Environ(5), WorksheetFunction.Find("=", Environ(5)) + 1, Len(Environ(5)))
Cells(satir, "B") = Now
ActiveWorkbook.Save
Windows("kayit.xls").Close
MsgBox "Kayıt işlemi tamamlandı", vbInformation, _
"KAYIT BAŞARILI OLDU"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & _
"Dosya kaydedilemedi", vbCritical, "Hatalı Şifre Girdiniz"
Cancel = True
End If
End Sub

Böyle yaptığımda pratik olarak çalışıyor fakat runtime error 9 hatası veriyor kayit.xls açık şekilde kalarak.

 

[ozgretmen]

Şu şekilde dener misin ?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
sifre = InputBox("KAYIT İÇİN ŞİFRE GİRMELİSİNİZ", _
"Yetkili Kişi", "Kaydetmek İçin Şifre girin")
If sifre = "123456" Then
Workbooks.Open Filename:="C:\kayit.xls"
satir = [A65536].End(3).Row + 1
Cells(satir, "A") = Mid(Environ(5), WorksheetFunction.Find("=", Environ(5)) + 1, Len(Environ(5)))
Cells(satir, "B") = Format(Date, "d mmmm yyyy dddd")
Cells(satir, "C") = Format(Now, "hh:mm:ss")
ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWindow.Close
MsgBox "Kayıt işlemi tamamlandı", vbInformation, _
"KAYIT BAŞARILI OLDU"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & _
"Dosya kaydedilemedi", vbCritical, "Hatalı Şifre Girdiniz"
Cancel = True
End If
End Sub

 

[desk]

harikasın ozgretmen üstadım. Son bir sorum
kayit.xls nin ikinci satırına kayıt etti çok güzel.
şifremizde 123456
Peki kayit.xls nin birinci satırındaki boş ilk hücrede 123456 yazdığını farz edersek bu şifreyi burdan nasıl alıp şifre kontrolü yaptırtabilirim.

sifre = "123456" kısmını
nasıl c:\kayit.xls nin ilk satırından çektirip sorgulatabilirim.

Bu arada halit3 sanada çok tşk fakat çalışmıyor kayit atmıyor kod.

 

[ozgretmen]

harikasın ozgretmen üstadım. Son bir sorum
kayit.xls nin ikinci satırına kayıt etti çok güzel.
şifremizde 123456
Peki kayit.xls nin birinci satırındaki boş ilk hücrede 123456 yazdığını farz edersek bu şifreyi burdan nasıl alıp şifre kontrolü yaptırtabilirim.

sifre = "123456" kısmını
nasıl c:\kayit.xls nin ilk satırından çektirip sorgulatabilirim.
Bu arada halit3 sanada çok tşk fakat çalışmıyor kayit atmıyor kod.

c:\kayit.xls A1 hücresine şifrenizi giriniz.

 

[desk]

olmadı. runtime hatası veriyor.

 

[ozgretmen]

olmadı. runtime hatası veriyor.

Kitabınızdaki ThisWorkbook modülündeki aşağıdaki kodda renkli kısımdaki yere kitabın adını yazınız.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Workbooks.Open Filename:="C:\kayit.xls"
Windows("[B][COLOR="Red"]Kitap1.xls[/COLOR][/B]").Activate 'Kendi Dosya Adınızı Yazınız...
UserForm1.Show
End Sub

 

[desk]

yazdım fakat olmadı zaten direk verdiğiniz kod dosyasında çalışmıyor.

 

[ozgretmen]

yazdım fakat olmadı zaten direk verdiğiniz kod dosyasında çalışmıyor.

Bende çalışıyor.C de kayit.xls dosyası olduğundan emin misiniz ?Emin isenin dosyayı tekrar indirip , bir daha dener misin ?

 

[desk]

eminim zaten en son revize edilmeden önce çalışıyor kayit.xls ye atıyor runtime error 9 hatası veriyor bende subscript out of range hatası alıyorum.

 

[ozgretmen]

eminim zaten en son revize edilmeden önce çalışıyor kayit.xls ye atıyor runtime error 9 hatası veriyor bende subscript out of range hatası alıyorum.

Kodların ilk kısmına ;

On Error Resume Next

ekler misin ?

 

[desk]

ekliyorum yine hata veriyor

If Val(TextBox1.Value) = Val(Workbooks("kayit.xls").Sheets("kayit").Range("A1").Value) * 1 Then

burayı sarı renk ile gösteriyor debug yapınca

 

[desk]

Hatayı buldum kayit.xls demde sheets im tabiki Sayfa1 di