farklı kaydetle yedeklerken şifre sormasın

[ex48]

farklı kaydet makroda şifre tanımla

ThisWorkbook'taki kod ile dosyadan çıkışta kayıt için şifre soruyor.
CommandButton8 koduyla farklı kaydette şifre sorgulama yapmadan şifreyi otomatik tanımlayıp dosyayı yedeklemesini sağlayabilirmiyiz.

Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
sifre = InputBox("KAYIT İÇİN ŞİFREYİ GİRMELİSİNİZ", _
"KAYIT", "ŞİFRE GİRİN")
If sifre = "x" Then
MsgBox "Tamam'ı tıklayıp, bekleyiniz", vbInformation, _
"Şifre Doğru"
Else
MsgBox "YANLIŞ ŞİFRE GİRDİNİZ." & Chr(13) & _
"DOSYA KAYDEDİLMEYECEK", vbCritical, "HATALI ŞİFRE"
Cancel = True
End If
End Sub

Private Sub CommandButton8_Click()
ChDir "D:\BELGELERİM\Yeşilkart\Arşiv"
dosya = Application.GetSaveAsFilename(Sheets("ANA SAYFA").Range("F6").Value & "_" & Format(Now, "dd.mm.yyyy_hh.mm.ss") & ".xls")
If dosya = False Then Exit Sub
ActiveWorkbook.SaveAs (dosya)
MsgBox " Bu dosya, D:\BELGELERİM\Yeşilkart\Arşiv klasörü içerisine yedeklendi.", vbInformation, "YEDEKLEME İŞLEMİ"

'Kaydedilmiş kabul et.
ThisWorkbook.Saved = True
'Başka dosya açık değilse exceli kapat.
If Application.Workbooks.Count = 1 Then
Application.Quit

'başka dosya açıksa sadece dosyayı kapat.
Else
ThisWorkbook.Close

End If
End Sub

 

[ex48]

yardım lütfen

 

[tahsinanarat]

kodu iptal et, olsun bitsin

 

[ex48]

1 nolu mesajdaki Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
kodlarının; aynı mesajda yazılı Private Sub CommandButton8_Click()
kodları çalışırken araya girip şifre sormaması mümkünmü?

Dosyada değ.kaydedilmesinde şifre sormalı...
Private Sub CommandButton8_Click şifre sormadan farklı kaydetmeli....

 

[ex48]

Tamamdır, gerek kalmadı. Sayın Uzmanamele'nin yöntemiyle halledildi.

Uzmanamele'den alıntıdır:
makro çalışırken diğer makro araya girdiği durumlarda şöyle bir yol uyguluyorum, deneyiniz

Public makro_atla As Integer

sub deneme()
makro_atla = 1
..
..
makro_atla = 0
end sub

Private Sub Worksheet_Activate()
If makro_atla = 0 then
..
..
end sub

normal olarak sayfa aktifleşmişse Worksheet_Activate makrosu çalışır
deneme makrosu çalışırken sayfayı ziyaret ediyorsa Worksheet_Activate makrosu atlanır (çalışmaz)