• DİKKAT

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

Kapat mesajına sayfa koruma yazmak.

  • Konbuyu başlatan Konbuyu başlatan kombo
  • Başlangıç tarihi Başlangıç tarihi
Katılım
17 Şubat 2006
Mesajlar
981
Excel Vers. ve Dili
M.Office Excel 2003 Tr.
Herkese merhaba
Aşağıdaki kapanış mesajına, Tüm çalışma kitabına "Sayfa koruma yaparak kapat" komutu ilave etmek istiyorum. Bir türlü yapamadım. Mavi olan yerle sadece çalıştığım sayfayı koruma yapabiliyorum. Diğer sayfalarıda korumak için ActiveWorkbook yapıyorum olmuyor. Püf noktasını çözemedim. Yardımcı olursanız sevinirim.

Sub auto_close()
kullanici = Application.UserName
saat = Format(Now, "hh:mm:ss")
tarih = Format(Date, "d mmmm yyyy dddd")
sor = MsgBox(" GÖRÜŞMEK ÜZERE " & kullanici & Chr(10) & Chr(10) & _
"YAZI" & Chr(10) & Chr(10) & _
"Tarih : " & tarih & Chr(10) & Chr(10) _
& "Saat : " & saat & Chr(10) & Chr(10) _
& "YAZI" & Chr(10) & Chr(10) & _
"Dosyanızın kaydedilmesini istiyor musunuz?", 4, "")
If sor = vbYes Then
For a = 1 To Sheets.Count
Sheets(a).Protect
Next
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close
End If

End Sub
 
Sn. fructoseİlginiz için teşekkür ederim. Yazmış olduğunuz linkleri inceledim. Oradaki kodları kendime uygulamaya çalıştım ama olmadı. Benim istediğim, Yukardaki kodların içinde işi çözümlemek.
Sağlıcakla kalın.
 
Bildiğim kadarıyla, sayfa koruması tek tek yapılan bir işlem.
Yani workbook diyerek kısaltma olmuyor.
Oradaki kodu;
Sheet1.Protect
Sheet2.Protect gibi çoğaltarak yazmayı deneyin..
 
Sn acemi1
Sn fructose'nin yazdığı linklerde Sn. leventm'im kodu şöyle:

Sub sifrele()
For a = 1 To Sheets.Count
Sheets(a).Protect "123" = True
Next
End Sub

Sn danersin'de şu şekil kodlamış;
Sub Makro1()
ActiveWorkbook.Protect Password:="a", Structure:=True, Windows:=False
End Sub

Her ikiside çalışma kitabını şifreliyor. Her ikisinden de parçalar alarak kendi kodlarımın içine monte etmeye çalıştım, ama bir türlü beceremedim :)
 
Kendi yazdığınız kodun içindeki mavi renkli satırı silip yerine benim veya Sn danersin'in verdiği kodu monte etmeniz yeterlidir.
 
Sn. leventm
Söylediğiniz şekli, en az on kere denedim. Yapamamıştım. (Mutlaka bir yerde hata yapıyordum) Sanki sihirli değnek değmiş gibi siz mesaj yazınca düzeldi . :)
 
Herkese iyi geceler
Yukardaki kodlarla çalışma kitabını kapatıyorum. Ama ben Exceli de kapatmak istiyorum. Kırmızı yazan yerlerde aşağıdaki kodlarla değişik denemeler yaptım ama beceremedim. (Aslında oluyor ama herşeyi iki kere yapıyor. Yani makro tekrar başa dönüp ikinci seferde kapatıyor.)
Exceli nasıl kapatabilirim.( Bu kodlarla)

ActiveWorkbook.Save
Application.Quit
 
Aşağıdaki gibi deneyin.

.
.
End if
Application.Quit
End Sub
 
Sn. leventm
O haliyle de denemiştim, yine denedim Ecxel kapanmadı. Başka makrolarda var, acaba onlardan mı etkileniyor diye boş kitap açtım ve sadece bu makroyu ekledim yine Excel açık kaldı.
 
Makrodan MsgBox kısmını silince düzeliyor. MsgBox olunca her işlemi iki kere yapıyor iki kere soruyor ve o zaman Excel de kapanıyor. Sorun MsgBox içeriğindemi acaba?


Sub auto_close()
kullanici = Application.UserName
saat = Format(Now, "hh:mm:ss")
tarih = Format(Date, "d mmmm yyyy dddd")
For a = 1 To Sheets.Count
Sheets(a).Protect
Next
sor = MsgBox(" GÖRÜŞMEK ÜZERE " & kullanici & Chr(10) & Chr(10) & _
"YAZI" & Chr(10) & Chr(10) & _
"Tarih : " & tarih & Chr(10) & Chr(10) _
& "Saat : " & saat & Chr(10) & Chr(10) _
& "YAZI" & Chr(10) & Chr(10) & _
"Dosyanızın kaydedilmesini istiyor musunuz?", 4, "")
If sor = vbYes Then
ActiveWorkbook.Save
End If
Application.Quit
End Sub
 
Makro bu haliylede iki kere işlem yapıyor.

Sub auto_close()
For a = 1 To Sheets.Count
Sheets(a).Protect
Next
If MsgBox(" Dosyanızın kaydedilmesini istiyor musunuz?", vbYesNo, "") = vbYes Then
ActiveWorkbook.Save
End If
Application.Quit
End Sub
 
Eğer dosyayı X işaretinden kapatırsanız iki kere işlem yapmaması gerekir.
 
Sn. leventm
En üstte yazılı kodlarla da "X" e bastığım zaman kapanıyor. Orda sorun yok. Amaç Kapat makrosuyla hem çalışma kitabını hem de Exceli kapatmak. Zaten bu gece de uğraşırım, yapamazsam bırakırım diye düşünüyorum. Ben de "X" ile kapatırım. :)
İlginiz için teşekkür ederim.
Sağlıcakla kalın.
 
Zaten auto_close makrosu eğer dosyayı X ten kapatıyorsanız gerçek işlevini yapar. Butona bağlayacaksanız farklı bir isim verin. Dosya kapanırken aynı kod tekrar çalıştığından mesaj veriyor.
 
Kodlarda uyarıyı ikinci kez almamak için "Next" ten sonra;

Application.DisplayAlerts = False ekleyin.
 
sn leventm
İlk önce Makro adını değiştirerek denemiştim olmamıştı, Fakat şimdi nerede hata yaptığımı buldum. Mavi olan yerle önce çalışma kitabını kapattığı için makronun çalışması devam etmiyor. O satırı silip "end if" den sonra "Application.quit " yazınca oldu. Hatayı hep ilk yazılan (auto_close) li makroyla çalıştığım için yaptım.
.
.
.
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close
End If
End Sub

sn. anemos
O satır zaten vardı . acaba ordan mı kaynaklanıyor diye silmiştim.

Her ikinize de ilginizden dolayı teşekkür eder,vaktinizi aldığım için özür dilerim.
Sağlıcakla kalın.
 
Kapat makrosunun son hali şöyle oldu;

Sub kapat()
If MsgBox("KAPATMAK İSTEDİĞİNİZDEN EMİN MİSİNİZ?", vbYesNo, "") = vbNo Then Exit Sub
kullanici = Application.UserName
saat = Format(Now, "hh:mm:ss")
tarih = Format(Date, "d mmmm yyyy dddd")
For a = 1 To Sheets.Count
Sheets(a).Protect
Next
sor = MsgBox(" GÖRÜŞMEK ÜZERE " & kullanici & Chr(10) & Chr(10) & _
"YAZI" & Chr(10) & Chr(10) & _
"Tarih : " & tarih & Chr(10) & Chr(10) _
& "Saat : " & saat & Chr(10) & Chr(10) _
& "YAZI" & Chr(10) & Chr(10) & _
"Dosyanızın kaydedilmesini istiyor musunuz?", 4, "")
If sor = vbYes Then
ActiveWorkbook.Save
Else
Application.DisplayAlerts = False
End If
Application.Quit
End Sub
 
Geri
Üst