• DİKKAT

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

Soru inputbox yazılan şifre görünmesin

  • Konbuyu başlatan Konbuyu başlatan k0081
  • Başlangıç tarihi Başlangıç tarihi
k0081

k0081

Katılım
17 Haziran 2008
Mesajlar
1,874
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Merhaba arkadaşlar;

inputbox ta şifreli bir giriş hazırlıyorum. Fakat girilen karakterler görünüyor. karakterleri ***** şeklinde nasıl gösterebiliriz ?

yardımcı arkadaşa şimdiden teşekkürler.
 
Userform ve üzerinde 1 textbox kullanın.
Textboxın passwordchar özelliğini * yapın.
 
Son düzenleme:
Merhaba,

Paylaştığınız linkteki kodlar ile bu işlemi yapamadım. Amacım bir excelde yapılacak düzenlemeleri kodla yapması ve bir butona bağlı olması fakat şifre ve vba daki şifre ile başkalarının buna ulaşamaması. Bu sebeple inputbox a * karakteri ile şifre girilmesi. Size örnek iletiyorum. Yardımcı olursanız sevinirim.

k0081' Alıntı:
onu biliyorum hocam. daha önce yaptım. Ama inputbox da bu işlem nasıl yapılabilir ? inputbox kullanacağım.

*************************** BU SORU ÇÖZÜMLENMİŞTİR. *************************************


http://www.freevbcode.com/ShowCode.asp?ID=1214
Bu linkteki kodlar ile yaptım. Teşekkürler.
Genişletmek için tıkla ...
 

Ekli dosyalar

wiseowl123' Alıntı:
Merhaba,

Paylaştığınız linkteki kodlar ile bu işlemi yapamadım. Amacım bir excelde yapılacak düzenlemeleri kodla yapması ve bir butona bağlı olması fakat şifre ve vba daki şifre ile başkalarının buna ulaşamaması. Bu sebeple inputbox a * karakteri ile şifre girilmesi. Size örnek iletiyorum. Yardımcı olursanız sevinirim.
Genişletmek için tıkla ...


Henüz Altın üye değilim. ( Ama bu sene olmayı düşünüyorum ;) )

Başka bir Paylaşım Linki verirseniz yardımcı olmaya çalışayım.
 
k0081' Alıntı:
Merhaba arkadaşlar;
inputbox ta şifreli bir giriş hazırlıyorum. Fakat girilen karakterler görünüyor. karakterleri ***** şeklinde nasıl gösterebiliriz ?
yardımcı arkadaşa şimdiden teşekkürler.
Genişletmek için tıkla ...
Bir modüle yapıştırıp deneyin (Alıntıdır)
Kod: 
'----------------------------------
'API CONSTANTS FOR PRIVATE INPUTBOX
'----------------------------------
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

'API işlevlerimizde kullanılacak fonksiyonlar
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

'----------------------------------
'PRIVATE PASSWORDS FOR INPUTBOX
'----------------------------------

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'VBA Giriş Kutusuna girilen karakterleri gizlemenizi sağlar.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim RetVal
    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    'Bir pencere aktif edildi

        RetVal = GetClassName(wParam, strClassName, lngBuffer)
       
        If Left$(strClassName, RetVal) = "#32770" Then  'Inputbox Sınıf Adı

            'Bu düzenleme kontrolünü, parola karakterini * gösterecek şekilde değiştirir.
            'Asc ("*") 'ı istediğiniz gibi değiştirebilirsiniz.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If

    End If
   
  
    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Function InputBoxDK(Prompt, Title) As String
    Dim lngModHwnd As Long, lngThreadID As Long

    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
   
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

    InputBoxDK = InputBox(Prompt, Title)
    UnhookWindowsHookEx hHook

End Function

Sub Demo()
101:
     x = InputBoxDK("Enter your Password.", "Password Required")
If StrPtr(x) = 0 Then
  'İptal düğmesine basıldı
   Exit Sub
ElseIf x = "" Then
   MsgBox "Please enter a password"
   GoTo 101:
Else
  'Tamam düğmesine basıldı pressed
  'Makronuzla devam edin.
  'Şifre "x" değişkeninde saklanır
End If
End Sub
 
Mahmut Bayram' Alıntı:
Bir modüle yapıştırıp deneyin (Alıntıdır)
Kod: 
'----------------------------------
'API CONSTANTS FOR PRIVATE INPUTBOX
'----------------------------------
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

'API işlevlerimizde kullanılacak fonksiyonlar
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

'----------------------------------
'PRIVATE PASSWORDS FOR INPUTBOX
'----------------------------------

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'VBA Giriş Kutusuna girilen karakterleri gizlemenizi sağlar.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim RetVal
    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    'Bir pencere aktif edildi

        RetVal = GetClassName(wParam, strClassName, lngBuffer)
      
        If Left$(strClassName, RetVal) = "#32770" Then  'Inputbox Sınıf Adı

            'Bu düzenleme kontrolünü, parola karakterini * gösterecek şekilde değiştirir.
            'Asc ("*") 'ı istediğiniz gibi değiştirebilirsiniz.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If

    End If
  
 
    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Function InputBoxDK(Prompt, Title) As String
    Dim lngModHwnd As Long, lngThreadID As Long

    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
  
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

    InputBoxDK = InputBox(Prompt, Title)
    UnhookWindowsHookEx hHook

End Function

Sub Demo()
101:
     x = InputBoxDK("Enter your Password.", "Password Required")
If StrPtr(x) = 0 Then
  'İptal düğmesine basıldı
   Exit Sub
ElseIf x = "" Then
   MsgBox "Please enter a password"
   GoTo 101:
Else
  'Tamam düğmesine basıldı pressed
  'Makronuzla devam edin.
  'Şifre "x" değişkeninde saklanır
End If
End Sub
Genişletmek için tıkla ...
Hocam teşekkür ederim.
 
Mahmut Bey Merhaba,

Kodlar 32 bit windows 7 de çalışıyor. Fakat işyerimdeki 64 bit windows 10 da ise aşağıdaki gibi hata veriyor.

Functionları 64 bite göre de tanımladım ama hata veriyor.

Doküman ektedir. İlgili konuda yardımcı olur musunuz?

1549291621518.png
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst