• DİKKAT

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

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

  • Konbuyu başlatan Konbuyu başlatan desk
  • Başlangıç tarihi Başlangıç tarihi
D

desk

Katılım
17 Ekim 2005
Mesajlar
288
Excel Vers. ve Dili
excel 2010 türkçe
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.!
 
aşağıda düzeltilmiştir
 
Son düzenleme:
hata veriyor.
Call GetComputerName(BilgiAdi, 64)
 
aşağıda düzeltildi
 
Son düzenleme:
Dosyayı inceler misin ?
Kod: 
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
 

Ekli dosyalar

kayit başarılı olduğunda kayit.xls ye kayıt atmıyor.
 
aşağıda düzeltildi
 
Son düzenleme:
Bu kodu eğer aşağıdaki prosedür içine yazar iseniz butona gerek kalmaz.
Kod: 
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
 
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.
 
Şu şekilde dener misin ?
Kod: 
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
 
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.
 
desk' Alıntı:
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.
Genişletmek için tıkla ...
c:\kayit.xls A1 hücresine şifrenizi giriniz.
 

Ekli dosyalar

desk' Alıntı:
olmadı. runtime hatası veriyor.
Genişletmek için tıkla ...
Kitabınızdaki ThisWorkbook modülündeki aşağıdaki kodda renkli kısımdaki yere kitabın adını yazınız.
Kod: 
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
 
yazdım fakat olmadı zaten direk verdiğiniz kod dosyasında çalışmıyor.
 
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.
 
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
 
Hatayı buldum kayit.xls demde sheets im tabiki Sayfa1 di :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst