InputBox'a girilen şifrenin (*****) olarak görünmesi

kemal turan · 5 Şubat 2012

Merhaba arkadaşlar,
Aşağıdaki kod sayfaya girişi şifreliyor.Kod da problem yok.
Fakat şifreyi bilmemesi gereken kişi yanınızda olduğunda yazdığınız şifreyi okuyup öğrenebiliyor.
İsteğim Şifreyi 12345 yazdığım zaman msgbox ta 12345 değilde , ***** olarak görünmesi.
Teşekkür ederim.

Private Sub Worksheet_Activate()
Application.Visible = False
sifre = "12345"
yazılan_sifre = InputBox("Şifrenizi yazın", "")
If yazılan_sifre <> sifre Then
MsgBox "Yetkili Değilsiniz", , "kemal turan"
Application.Visible = True
Sheets("planlama").Select
Else
Application.Visible = True
Sayfa2.Select
End If
End Sub

Orion1 · 5 Şubat 2012

userform ve textbox kullanınız.
Onun özelliklerinden PasswordChar özelliğine * karakterini giriniz.

kemal turan · 5 Şubat 2012

Sn.Orıon,
Ahhh bir user form ve text box oluşturup bunları ilişkilendirip birşeyler yapabilsediim.

Yaş 50 ye dayanınca bu işleri öğrenelim dediğimizde işlemcimiz ısınıyor.
Ancak aldığımız kodları kendimize uyarlamayı başarmaya çalışıyoruz.
Yukarıdaki kodu da Sn.hamitcan bey verdi.
Makro kodunda mümkün değil herhalde.Olmuyorsa ne yapalım .
Önerinizi de size yapın desem zahmet olur diye düşünüyorum.
Çok teşekkür ederim.
Selametle kalınız

Orion1 · 5 Şubat 2012

kemal turan' Alıntı:
Sn.Orıon,
Ahhh bir user form ve text box oluşturup bunları ilişkilendirip birşeyler yapabilsediim.
Yaş 50 ye dayanınca bu işleri öğrenelim dediğimizde işlemcimiz ısınıyor.
Ancak aldığımız kodları kendimize uyarlamayı başarmaya çalışıyoruz.
Yukarıdaki kodu da Sn.hamitcan bey verdi.
Makro kodunda mümkün değil herhalde.Olmuyorsa ne yapalım .
Önerinizi de size yapın desem zahmet olur diye düşünüyorum.
Çok teşekkür ederim.
Selametle kalınız

Olabilir.
Bende 51 yaşındayım.Ama hala öğreniyorum.
Öğrenmenin yaşı olmaz demiş atalarımız.
inputbox ile olmuyor maalesef.
Userform ve textbox kullanmanız lazım.

kemal turan · 5 Şubat 2012

Sn Orıon;
Temelimiz olmadığı ve günlük iş yükümüzden dolayı masa üstümüz bir hayli dolu.Bu da yavaşlamamıza neden oluyor.
Bir de işlemcimiz tek çekirdek herhalde

Çok teşekkür ederim.
Selametle kalın

Orion1 · 5 Şubat 2012

kemal turan' Alıntı:
Sn Orıon;
Temelimiz olmadığı ve günlük iş yükümüzden dolayı masa üstümüz bir hayli dolu.Bu da yavaşlamamıza neden oluyor.
Bir de işlemcimiz tek çekirdek herhalde
Çok teşekkür ederim.
Selametle kalın

Anladım.
Kolay gelsin,İyi geceler.

paranormal · 6 Şubat 2012

Beyler, durun bakalim!!!

Bende 58 yasindayim. ve hala bilgisayarin basinda excelle ugrasiyorum.

Bu kodu kullanirsaniz yazdiginiz harf ve rakamlar görünmüyor... kolay geslin beyler

Sub Aut

pen()
Dim MyPassword
hatali:
MyPassword = InputBox("Lütfen sifrenizi giriniz", "Password Prompt", "********")
If MyPassword = "Buraya sifreniz" Then
AdresEklemeForm.Show 'Buraya Sheet adi gelecek
Exit Sub
Else
UserForm1.Show 'Buraya da mesajiniz gelecek yani girdiginiz isim bulunamadi gibi

GoTo hatali
End If
End Sub

Ve benden size hediye, fotografli Adres Defteri... kullanmak isteyenler için güle güle kullansin...

Dosyam asagidadir

Paranormal.

kemal turan · 6 Şubat 2012

Sn.Paranormal iyi geceler,
Verdiğiniz kod bir makro ve bir düğme yardımı ile çalışıyor.
Benim isteğim ek dosyada da belirttim ;
Sayfa1 seçildiğinde açılsın
Sayfa2 ve 3 açılmak istendiğinde şifre sorsun.
şifre girerkende şifre örnek 1234 değilde 1234 yazıldığında **** şeklinde görünsün.
Ek dosyaya uygulayabilirseniz sevinirim.
Hollandaya selamlar

Orion1 · 6 Şubat 2012

Sayın paranormal,alakanız için teşekkür ederim.
Yolladığınızda veri girmeye başlayınca *** göstermiyor.
Yalnız ilk açılışta **** gösteriyor.
Arkadfaşın istediği ise her karakteri girince yıldız göstermesi.
İyi çalışmalar olsun.

s.savas · 6 Şubat 2012

Selamlar.
Öncelikle bir modüle aşağıdaki kodu copy-paste yapınız.
Not: Kodlar alıntıdır.

Kod:

Option Explicit

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003

'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'//
'// Amended 5th March 2004 for Gopal
'// This allows it to be run on Xl97+
'////////////////////////////////////////////////////////////////////


'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim RetVal As Long
Dim strClassName As String, lngBuffer As Long

If lngCode < HC_ACTION Then
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If

strClassName = String$(256, " ")
lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then    'A window has been activated
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
    If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
        'This changes the edit control so that it display the password character *.
        'You can change the Asc("*") as you please.
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
    End If
End If
    
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam

End Function

'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Long, Optional Ypos As Long, Optional Helpfile As String, Optional Context As Long) As String
    
Dim lngModHwnd As Long, lngThreadID As Long
    
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
  
#If VBA6 Then
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
#Else
    hHook = SetWindowsHookEx(WH_CBT, AddrOf("NewProc"), lngModHwnd, lngThreadID)
#End If

If Xpos Then
    InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
    InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If

ExitProperly:
UnhookWindowsHookEx hHook

End Function

Sonrada herhangi bir butona atanan Private Sub yordamına aşağıdaki kodu ekleyiniz.

Kod:

giris = InputBoxDK("şifre giriniz.", "Şifre penceresi", "")
sifre = "1234" ' Şifrenizi buraya tanımlayınız.
If giris = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
If giris <> sifre Then
MsgBox "şifre yanlış"
Exit Sub
End If

Korhan Ayhan · 6 Şubat 2012

Merhaba,

Bu konu daha önce işlenmişti. Aşağıdaki linkten cevaba ulaşabilirsiniz.

İnputboxa girilen şifrenin yıldız karakteri olarak görünmesi

Cevap yetersiz gelirse forumda inputbox+şifre ifadesi ile arama yapınız.

Orion1 · 6 Şubat 2012

Arkadaşlar çözümü vermişler.
Ama ben userform tercih ederim.Api lerden mümkün olduğunca kaçıyorum ziraa.
Çok mecbursam api kullanıyorum.
Attığınız taş ürküttüğün kurbağaya değmez derim.
Kolay gelsin.

kemal turan · 6 Şubat 2012

Sn.S.Savaş
Verdiğiniz kodları uyarladım.
Çok güzel çalıştı.Fakat
Ek dosyada uyarlanmış haline bakarsanız.şifre sorma esnasında sayfadaki veriler görülmekte.
Benim ilk sorumda olan kod sayfa tıklandığında hiç bir bilgiyi göstermiyor.
Yanlış olduğunda da izin verilen sayfaya geri gitmesini sağlamıştım.
Kırmızı renkli özellikleri sizin kodunuza katabilirmiyiz.
Teşekkürler

kemal turan · 6 Şubat 2012

Pardon dosya ek tedir.

kemal turan · 6 Şubat 2012

Merhaba ustadlar,
Forumdaki kodlardan alınıtılar yaparak aşağıdaki kırma

kodu oluşturdum.
Tam istediğim gibi oldu.
Herkese sonsuz teşekkürler.

Private Sub Worksheet_Activate()
Application.Visible = False
giris = InputBoxDK("şifre giriniz.", "Şifre penceresi", "")
sifre = "1234" ' Şifrenizi buraya tanımlayınız.
If giris = "" Then
MsgBox "İşlemi iptal ettiniz"
Application.Visible = True
Sheets("sayfa1").Select
Else
Application.Visible = True
Sayfa1.Select
End If
End Sub

kemal turan · 6 Şubat 2012

Yukarıdaki kod da şifre doğru ise sayfa açılmıyordu.
Aşağıdaki hali ile problem kalktı.
İyi geceler
Herkese teşekkür ederim.
Private Sub Worksheet_Activate()
Application.Visible = False
giris = InputBoxDK("şifre giriniz.", "Şifre penceresi", "")
sifre = "1234" ' Şifrenizi buraya tanımlayınız.
If yazılan_sifre <> sifre Then
Application.Visible = True
Sheets("sayfa2").Select
Else
Application.Visible = True
Sayfa1.Select
End If
End Sub

paranormal · 6 Şubat 2012

Evet arkadaslar, haklisiniz, simdi ben de denedim. Dediginiz gibi. Her karaktesi yazdigimda karakteri gösteriyor..

Ögrenmeye devam......................

paranormal · 6 Şubat 2012

s.savas' Alıntı:

Selamlar.
Öncelikle bir modüle aşağıdaki kodu copy-paste yapınız.
Not: Kodlar alıntıdır.

Kod:

Option Explicit

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003

'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'//
'// Amended 5th March 2004 for Gopal
'// This allows it to be run on Xl97+
'////////////////////////////////////////////////////////////////////


'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim RetVal As Long
Dim strClassName As String, lngBuffer As Long

If lngCode < HC_ACTION Then
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If

strClassName = String$(256, " ")
lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then    'A window has been activated
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
    If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
        'This changes the edit control so that it display the password character *.
        'You can change the Asc("*") as you please.
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
    End If
End If
    
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam

End Function

'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Long, Optional Ypos As Long, Optional Helpfile As String, Optional Context As Long) As String
    
Dim lngModHwnd As Long, lngThreadID As Long
    
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
  
#If VBA6 Then
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
#Else
    hHook = SetWindowsHookEx(WH_CBT, AddrOf("NewProc"), lngModHwnd, lngThreadID)
#End If

If Xpos Then
    InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
    InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If

ExitProperly:
UnhookWindowsHookEx hHook

End Function

Sonrada herhangi bir butona atanan Private Sub yordamına aşağıdaki kodu ekleyiniz.

Kod:

giris = InputBoxDK("şifre giriniz.", "Şifre penceresi", "")
sifre = "1234" ' Şifrenizi buraya tanımlayınız.
If giris = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
If giris <> sifre Then
MsgBox "şifre yanlış"
Exit Sub
End If

Haklisiniz benim gönderdigim kod da sifre yazilirken karakterler görünüyor,
Yalniz, arkadasin gönderdigi kod harika, tebrikler nereden bulduysa.

Yalniz arkadaslar ben bir Dosya göndermistim, Fotografli Adres Defteri, deneme firsatiniz oldumu acaba?

Paranormal..

Barons · 30 Mayıs 2012

bende 50 yaşındayım ...vay be bende en yaşlılarıyım herhalde diye düşünürdüm hep

InputBox'a girilen şifrenin (*****) olarak görünmesi

kemal turan

Orion1

Uzman

kemal turan

Orion1

Uzman

kemal turan

Orion1

Uzman

paranormal

kemal turan

Ekli dosyalar

Orion1

Uzman

s.savas

Korhan Ayhan

Administrator

Orion1

Uzman

kemal turan

kemal turan

Ekli dosyalar

kemal turan

kemal turan

paranormal

paranormal

Barons