Makroyu çalıştırma istendiğinde, şifre sorulması hususu..!

[Yatutarsa]

Merhaba arkadaşlar,

Forumdaki soru-cevap ve araştırmalarım neticesinde hedefime ramak kaldı gibi ancak ufak bi yardıma daha tarafınızdan ihtiyacım var. Problemimi yazının en sona yazdım ancak fikir vermesi açısından bulduğum verileri sizinle paylaşıyorum.

Çalışma Sayfasına koruma eklemek;

Sub koru()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Protect "123"
Next
Application.ScreenUpdating = True
End Sub

Korumayı açmak:

Sub koruac()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Unprotect "123"
Next
Application.ScreenUpdating = True
End Sub

Makroyu çalıştırmadan önce şifre sorulması:

Sub sifre()
If InputBox("SIFREYİ GIRINIZ") = 123 Then
......... (Makro kodu buraymış)
End If
End Sub

Sonuç;

Sub sifrele()
If InputBox("SIFREYI GIRINIZ") = 123 Then
Sub koru()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Protect "123"
Next
Application.ScreenUpdating = True
End Sub
End If
End Sub

Sub sifrele()
If InputBox("SIFREYI GIRINIZ") = 123 Then
Sub koruac()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Unprotect "123"
Next
Application.ScreenUpdating = True
End Sub
End If
End Sub

Koru ve koruac makrolarindaki 123 neyi temsil ediyor bilmiyorum, ama şifre koruması değil. Bu yüzden bu makrolara şifre koruma koymaya yöneldim ve ortaya yukardaki gibi bi kod çıktı. Nedense çalışmadı :mrgreen: Ben nerde yanlış yapıyorum :???: Veya bildiğiniz benim problemimi çözmeye hizmet edecek başka bir kod var mı?

Teşekkürler.

 

[Ferhat Pazarçevirdi]

Buradaki "123"; "Sayfa Koruma Şifresi"dir. Araçlar->Koruma-Sayfayı Koru'da olduğu gibi ... Bir inputbox ile korumayı açmanız ve kaldırmanız için tasarlanmışlar. Şirfe korumasu dediğiniz şey nedir? Eğer projenizdeki kodlara ulaşılamaması ise; VBE'de Tools->VBAProject Properties'i deneyin.

 

[Yatutarsa]

Buradaki "123"; "Sayfa Koruma Şifresi"dir. Araçlar->Koruma-Sayfayı Koru'da olduğu gibi ... Bir inputbox ile korumayı açmanız ve kaldırmanız için tasarlanmışlar. Şirfe korumasu dediğiniz şey nedir? Eğer projenizdeki kodlara ulaşılamaması ise; VBE'de Tools->VBAProject Properties'i deneyin.

Öncelikle cevap için teşekkürler.

Bu koru ve koruac makrolarını yalnız çalıştırırken, sayfa koruma şifresi olan 123'ü hiç sormadı. Sanırım sizi "Şirfe korumasu dediğiniz şey nedir?" sorusuna da bu ayrı makro kodlarında ki aynı işleve sahip şifre güvenliği yöneltti.
Vesselam koru ve koruac makrolari sifre sorulmaksizin çalışıyor. Benim problemim bu öyleyse. Eğer bu iki makroyu (koru ve koruac) çalıştırırken şifre sorulmasını sağlayabilirsem, başka bişeye ihtiyacım olmayacak.

Benim amacim da bu makro kodlarıyla aslında bahsettiğiniz gibi (araclar->sayfa koruma) şifreyle sayfa koruma opsiyonunu, 100ün üzerinde olan sekmesi olan çalışmamın, her sekmesine teker teker uygulamada ki zaman ve emeği en aza indirmekti. Eğer bu koru ve koruac makrolarındaki 123 şifreyse ve sorulmuyorsa kodda bir problem var demektir, çünkü kullanımdan kaynaklanan bir problem olacağını zannetmiyorum. Benim yaptığım sadece kodu alıp, yapıştırıp çalıştırmak.

Sizce bu bahsi geçen koru ve koruac makrolarında ki şifreler neden sorulmuyor olabilir? Bu iki makronun çalıştırılırken şifre sormasını nasıl sağlayabilirim?

Teşekkürler.

 

[Ferhat Pazarçevirdi]

Şu kodları kullanınız:

Koruma sağlamak için

Sub koru()
sifre = InputBox("Aşağıdaki kutucuğa şifrenizi yazın :", "ŞİFRE NE OLSUN ?")
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Protect sifre
Next
Application.ScreenUpdating = True
End Sub

Korumayı kaldırmak için:

Sub koruac()
sifre = InputBox("Sayfa Koruma Şifresini giriniz", "ŞİFRE KALDIRMAK İÇİN")
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Unprotect sifre
Next
Application.ScreenUpdating = True
End Sub

 

[Yatutarsa]

Çok çok çok teşekkür ederim. Mükemmel oldu. inanın çok sevindim

Eğer fazla olmayacaksam son bişey. (insanoğlu işte

Yaptığım çalışma başkaları tarafından kullanılacak ve bazı düzeltmeler gerektiğinde yanlarında sayfa korumasını açmam gerekecek. Şu şifreleme olayında girilen rakam ap açık ortada gözüküyor. Bunun yerine, yıldızlarla veya herhangi bi karakterler ifade edilmesini sağlayabilirmiyiz?

Biliyorum çok oluyorum. Bu cevabıda alırsam uzun süre sizi rahatsız etmeyeceğim söz veriyorum

 

[veyselemre]

http://www.xcelfiles.com/API_09.html

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları; bir modul sayfasına aktarınız.

Sn.Veyselemre'nin de kaynağını gösterdiği gibi, api fonksiyonları IvanF.Moala'dan uyarlanmıştır.

 Option Explicit
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Private Const nIDE As Long = &H100
Private Const EM_SETPASSWORDCHAR = &HCC
Private hdlEditBox As Long
Private Fgrndhdl As Long
Public Function TimerFunc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal nEvent As Long, ByVal nSecs As Long) As Long
    Dim hdlwndAct As Long
    If hdlEditBox > 0 Then Exit Function
    hdlwndAct = GetActiveWindow()
    hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")
    SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0
End Function
Public Function InPutBoxPwd(fPrompt As String, _
    Optional fTitle As String, _
    Optional fDefault As String, _
    Optional fXpos As Long, _
    Optional fYpos As Long, _
    Optional fHelpfile As String, _
    Optional fContext As Long) As String
    Dim sInput As String
    hdlEditBox = 0
    Fgrndhdl = GetForegroundWindow
    SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc
    If fXpos Then
        sInput = InputBox(fPrompt, fTitle, fDefault, fXpos, fYpos, fHelpfile, fContext)
    Else
        sInput = InputBox(fPrompt, fTitle, fDefault, , , fHelpfile, fContext)
    End If
    KillTimer Fgrndhdl, nIDE
    InPutBoxPwd = sInput
End Function
Sub koru()
Dim sifre, sayfa
sifre = InPutBoxPwd("Aşağıdaki kutucuğa şifrenizi yazın :", "ŞİFRE NE OLSUN ?")
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Protect sifre
Next
Application.ScreenUpdating = True
End Sub
Sub koruac()
Dim sifre, sayfa
sifre = InPutBoxPwd("Sayfa Koruma Şifresini giriniz", "ŞİFRE KALDIRMAK İÇİN", , , , , "*")
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Unprotect sifre
Next
Application.ScreenUpdating = True
End Sub

 

[Yatutarsa]

Çok saolun. Veyselemre'ye cevap için, fpc'ye de türkçe meali için

Sayın FPC. Gönderdiğiniz kod koru makrosunda çok iyi çalıştı ancak koruac makrosu calışmıyor. Sayın Veyselemre kendimi gönderdiğiniz sayfayı anlayacak kadar maro biliyo saymıyorum, ancak 3 kodu da indirdim. Şimdi 3 kodu da sayın FPC'nin verdiği şekilde koru ve koruac makrolarının üzerine yapıştırıcam. Bakalım randıman alabilecekmiyim böyle.

Yaptıklarınıza Müteşekkirim. Bu kadar yardımı para versem alabileceğimi sanmıyorum.

 

[Ferhat Pazarçevirdi]

Sayın FPC. Gönderdiğiniz kod koru makrosunda çok iyi çalıştı ancak koruac makrosu calışmıyor.

Çalışmaz, çünkü hata yapmışım. Koruac'taki Şu satırı değiştirin :

sifre = InPutBoxPwd("Sayfa Koruma Şifresini giriniz", "ŞİFRE KALDIRMAK İÇİN", , , , , "*")

Şu şekilde değişecek

sifre = InPutBoxPwd("Sayfa Koruma Şifresini giriniz", "ŞİFRE KALDIRMAK İÇİN")

 

[Yatutarsa]

Yaw teşekkür et et, yine de size karşı olan mahcubiyetimi ve borcumu yerine getirmez.

Saatlerdir yazışıyoruz, bu ilgi alakayı babamınoğlu göstermezdi.

Çok çok çoooooooook teşekkür ederim.

Eline, koluna gözünün ferine bilumum yerlerine sağlık.

Ne kadar makbule geçti yazdığınız kod bilemezsiniz.

Tekrar sağolun.

Sevgiler....

 

[baydeniro]

Çok güzel nir konu. Herkeze değil herkeSe teşekkürler.