button ya da formüle şifre koyma

[incsoft]

Arkadaşlar buttonumda çalışan kodumu bazı kişilerin kullanmamasını istediğim için macro ya da button'a şifre koymak istiyorum bunu nasıl yapabilirim?

Teşekkürler.




Private Sub CommandButton2_Click()

Range("A68:O73,Q68:AD73").Select
Range("Q68").Activate
Selection.Copy
Application.CutCopyMode = False
Range("A68:B73").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C68:K73").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L68:O73").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q68:R73").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("S68:AB73").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AC68:AD73").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("AG69").Select
ActiveWindow.SmallScroll Down:=-104
Range("Z1:AD1").Select
End Sub

 

[Muzaffer Ali]

Merhaba.
Kodların ikinci satırına aşağıdaki kodları kopyalayın.
Şifreyi "123" olarak yazdım siz istediğiniz şifre ile değiştirebilirsiniz.

    If InputBox("Lütfen şifre giriniz") <> "123" Then
        MsgBox "Şifre yanlış. Lütfewn kontrol ederek yeniden deneyiniz."
        Exit Sub
    End If