Jump to content

Clave de ingreso visible con puntitos o en color blanco


jose luna

Recommended Posts

Hola amigos:

Será posible hacer que la clave de ingreso sea visible en pantalla solo como puntos, a fin de que otros usuarios no vean qué clave estoy ingresando? También podria ser cambiar el color a letras de la clave y dejarlas color blanco.

Son pequeños detales que marcan la diferencia entre lo público y lo privado... creo yo.

Agradecido de su colaboración desde ya.

Atentos saludos

Adjunto código de clave que estoy usando:

Sub Cambio_de_Mes_Tributario()

clave = InputBox("FAVOR INGRESE CLAVE DE ACCESO PARA CAMBIO DE MES TRIBUTARIO ACTUAL de " & Sheets("Inicio").Cells(5, 20), _

" R y L cía Ltda, Mes " & Sheets("Inicio").Cells(5, 20))

If clave <> "cambiarmes" Then Exit Sub

UserForm25.Show

End Sub

Link to comment
Share on other sites

Re: Clave de ingreso visible con puntitos ó en color blanco

Buen día josé luna;

Ve al userfor, después al textbox en dónde ingresarás la clave ve a propiedades (F4) busca la opción PasswordChar estará en blanco ahí pon el caracter que quieras (*,+,-) y listo resolverás tu problema, al ingresar el password se verá sólo el caracter que elegiste...

Si no es lo que buscas, o te atoras... comentas....

Link to comment
Share on other sites

Hola amigos:

Será posible hacer que la clave de ingreso sea visible en pantalla solo como puntos, a fin de que otros usuarios no vean qué clave estoy ingresando? También podria ser cambiar el color a letras de la clave y dejarlas color blanco.

Son pequeños detales que marcan la diferencia entre lo público y lo privado... creo yo.

Agradecido de su colaboración desde ya.

Atentos saludos

Adjunto código de clave que estoy usando:

Sub Cambio_de_Mes_Tributario()

clave = InputBox("FAVOR INGRESE CLAVE DE ACCESO PARA CAMBIO DE MES TRIBUTARIO ACTUAL de " & Sheets("Inicio").Cells(5, 20), _

" R y L cía Ltda, Mes " & Sheets("Inicio").Cells(5, 20))

If clave <> "cambiarmes" Then Exit Sub

UserForm25.Show

End Sub

En lugar de utilizar un inputbox mejor utiliza un textbox, es decir las mismas instracciones que estas dando dejalas igual pero en lugar de poner inputbox= llama a otro userform en el cual pongas un textbox y un commandbutton y en las propiedades del textbox poner password char *,x o el simbolo que quieras

Link to comment
Share on other sites

...un InputBox que es el que quiero poerle un cambio de color para cuando ingrese la clave se vean solo puntitos o bien no se vea ninguna escritura en pantalla....

Pues no sé si sea posible con un inputbox... definitivamente lo más fácil es usar un userform con un textbox que te ofrece esa propiedad.

En todo caso, podrías crear el userform con otra macro. Mira este código de Ivan Moala (http://www.xcelfiles.com/), generará un userform con las características que quieres y al final lo borrará.

Public OK As Boolean
Function GetPassWord(Title As String, clave As String) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : GetPassWord
' DateTime : 4/02/02 19:04
' Author : Ivan F Moala
' Purpose : Creates a Dynamic UF to Test for aPassword
' : so there is no need to create one.
'---------------------------------------------------------------------------------------
Dim TempForm
Dim NewTextBox As Object
Dim NewCommandButton1 As Object
Dim NewCommandButton2 As Object
Dim x As Integer

' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False

' Create a Temp UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)

' Add a TextBox
Set NewTextBox = TempForm.Designer.Controls.Add("forms.textbox.1")
With NewTextBox
.PasswordChar = "*"
.Width = 140
.Height = 20
.Left = 48
.Top = 18
End With

' Add the OK button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Default = True
.Height = 18
.Width = 66
.Left = 126
.Top = 66
End With

' Add the Cancel button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Cancel = True
.Height = 18
.Width = 66
.Left = 30
.Top = 66
End With

' Add event-handler subs for the CommandButtons & Userform
With TempForm.CodeModule
x = .CountOfLines
.insertlines x + 0, "Sub CommandButton2_Click()"
.insertlines x + 1, "Unload Me"
.insertlines x + 2, "End Sub"
.insertlines x + 3, "Sub CommandButton1_Click()"
.insertlines x + 4, "If TextBox1 = """ & clave & """ Then OK = True: Unload Me"
.insertlines x + 5, "End Sub"
.insertlines x + 6, "Private Sub UserForm_Initialize()"
.insertlines x + 7, "Application.EnableCancelKey = xlErrorHandler"
.insertlines x + 8, "End Sub"
End With

' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = 240
.Properties("Height") = 120
NewCommandButton1.Left = 46
NewCommandButton2.Left = 126
End With

' Show the form
VBA.UserForms.Add(TempForm.Name).Show

' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm

' Pass the Variable back to the calling procedure
GetPassWord = OK

End Function[/CODE]

lo copias en un módulo normal, luego para usarlo puedes probar algo así:

[CODE]Sub Prueba()

If GetPassWord("Verificación de acceso", "[COLOR="red"]XXXX[/COLOR]") = True Then
'...codigo si la clave es correcta
MsgBox "Ejecutando...."
End If

End Sub[/CODE]

En donde "[color=red]XXXX[/color]" es la clave que vas a usar.

Adjunto archivo con el código para que lo pruebes.

El código lo tomé de MrExcel (escrito por Ivan Moala), este es el post: http://www.mrexcel.com/archive/VBA/19882a.html

bueno, es una alternativa si no quieres crear el userform (aunque igual eso es lo que hace el código :D).

Libro1.zip

Link to comment
Share on other sites

Hola

La forma mas facil de obtener lo que deseas es ir al editor de VBA (VBE) insertar un formulario agregarle un textbox y realizar el procedimiento que te menciono Carlos@Muñiz

Ahora si lo que deseas es crear el Input Box para introducir la contraseña (todo mediante programación), puedes usar la macro que expuso el master mjrofra, (siguiendo la misma linea del master) elabore un inputbox pero con un cuadro de dialogo de Excel 5.0 dónde se puede introducir la contraseña y no se obsevan los caracteres introducitos (el Código crea y destruye el inputbox al finalizar). En este caso solo deber modificar las rutinas principales para que funcione como deseas:

en un modulo estandar pega este código

Option Explicit
Private InputContraseña As Variant 'Almacena la Contraseña [Su valor es False se presiono Cancelar]
Private DlgContraseña As DialogSheet 'Hoja Dialogo Excel 5.0
Private LblMensaje As Object 'Label de Mensaje para el usuario en el inptubox
Private TxtContraseña As Object 'EditBox donde el usuario introduce la contraseña
Private ContraseñaCorrecta As String 'Almacena la Contraseña Correcta
Private Titulo As String 'Titulo del Inputbox
Private Mensaje As String 'Mensaje para el usuario en el inpubox
Private HojaActual As String 'Almacena el nombre de la hoja activa al llamar el dialogo
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'[Rutinas principales]
'Permiten mostrar el inputbox simulado, indicar la contraseña correcta, con la cual se comparará
'y establecer las acciones [rutinas] a seguir si fue correcta la contraseña o lo no fue
'estos son los unicos parametros que requieren modificación de programación
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Muestra_ImputBoxSimulado()
'''''''''''''''''''''''''''''''''''''''''
'Muestra el Inputbox Simulado y establece
'la contraseña correcta con la cual se
'comparará la contraseña introducida por
'el usuario, además indica el titulo y
'el mesaje en el inputbox simulado
''''''''''''''''''''''''''''''''''''''''
ContraseñaCorrecta = "miclave"
Titulo = "INTRODUCIR CONTRASEÑA"
Mensaje = "Favor de Ingresar la Clave de Acceso para cambio de mes tributario"
'llama a procedimiento auxiliares
SimulaInputboxContraseña
End Sub

Private Sub Contraseña_Correcta()
''''''''''''''''''''''''''''''''''''''''
'procedimiento si contraseña es Correcta
'''''''''''''''''''''''''''''''''''''''''
MsgBox "Contraseña Correcta", vbInformation
End Sub

Private Sub Contraseña_Incorrecta()
''''''''''''''''''''''''''''''''''''''''''
'Procedimiento si contraseña es incorrecta
''''''''''''''''''''''''''''''''''''''''''
MsgBox "Contraseña Incorrecta", vbCritical
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'[Rutinas auxiliares para mostrar el inputbox simulado]
'Estas rutinas son de auxilio para el inputbox, no requiren modificar ningun parametro
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'***************************************************************************************************
Private Sub SimulaInputboxContraseña()
'[Crea un Dialogo de Excel 5.0]

Application.ScreenUpdating = False '[Es importante establecer en false para que no se vea]

'El Dialogo se crea como una hoja si esta protegido el libro
'no se puede crear y por tanto se produce error
InputContraseña = False 'Se establece en falso
If Not ActiveWorkbook.ProtectStructure Then
HojaActual = ActiveSheet.Name
'crea el cuadro de dialogo temporal
Set DlgContraseña = ThisWorkbook.DialogSheets.Add ' Añade la hoja
'Acciones de los botones aceptar y cancelar
ActiveSheet.Shapes("Button 2").OnAction = "Aceptar"
ActiveSheet.Shapes("Button 3").OnAction = "Cancelar"
With DlgContraseña.DialogFrame
.Top = 0
.Left = 0
.Height = 100
.Text = Titulo
End With
'crea los text temporales
Set LblMensaje = DlgContraseña.Labels.Add(5, 20, 160, 45)
LblMensaje.Text = Mensaje
Set TxtContraseña = DlgContraseña.EditBoxes.Add(5.25, 73.5, 157.5, 15.75)
TxtContraseña.PasswordEdit = True
DlgContraseña.Show 'Mostramos el Dialogo
'Aqui se detiene el proceso en espera de Aceptar o Cancelar....
End If
Finaliza
End Sub
Private Sub Finaliza()
'On Error Resume Next
'borramos cuadro de dialogo
Application.DisplayAlerts = False
DlgContraseña.Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True
Sheets(HojaActual).Activate 'reestablece la hoja activa
'liberamos los objetos
Set DlgContraseña = Nothing
Set LblMensaje = Nothing
Set TxtContraseña = Nothing
End Sub
Private Sub Aceptar()
'Al presiona Aceptar
If Len(TxtContraseña.Text) > 0 Then
InputContraseña = TxtContraseña.Text
If InputContraseña = ContraseñaCorrecta Then
Contraseña_Correcta
Else
Contraseña_Incorrecta
End If
Else
MsgBox "Falta la Contraseña", vbInformation
Application.OnTime Now + TimeValue("00:00:01"), "Muestra_ImputBoxSimulado"
End If
End Sub
Private Sub Cancelar()
'Al presionar cancelar
InputContraseña = False
End Sub

'***************************************************************************************************[/CODE]

Adjunto el ejemplo tambien.

saludos cordiales

InputBox_UsandoDialogo5-nvr.zip

Link to comment
Share on other sites

He tomado el código y lo incrusté al principio del código de limpieza de formularios y cambio de mes tributario, y funcionando perfecto con el detalle que si doy opción " Cancelar ", igual se ejecuta la macro y borra los formularios y cambia al próximo mes. La idea es que si se mete una clave incorrecta, o si se oprime botón " Cancelar ", que no se siga ejecutando la macro y haga salir de esa opción.... Ojalá me haya dado a entender bien.

Gracias una vez mas por respuestas tan óptimas de mis amigos foreros.

Cordiales saludos

Link to comment
Share on other sites

muy buenas sugerencias chicos...aunque me quede pensando que alguien ya habia resuleto un tema similar con un 'verdadero' input !!!!!???

bueno se me hizo mas facil buscar en mi baul de excel:

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

'////////////////////////////////////////////////////////////////////


'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 = &amp;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
Dim strClassName As String, lngBuffer As Long

If lngCode &lt; 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, &amp;H1324, EM_SETPASSWORDCHAR, Asc("*"), &amp;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&gt; App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)

hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
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

Sub TestDKInputBox()
Dim x

x = InputBoxDK("Ingrese su Contraseña aqui.", "Contraseña Requerida")
If x = "" Then End
If x &lt;&gt; "Tu contraseña" Then
    MsgBox "No ingreso la contraseña correcta ."
    End
End If

MsgBox "Welcome Creator!", vbExclamation

End Sub

o chequen el ejemplo

tambien encontraran otro ejemplo muy parecido en: http://accessvbafaq.mvps.org/item.asp?pagina=37 mismo que no subí ya que el autor pide como requisito el contactar con el,previa publicacion a en alguna pagina web,situación que es altamente respetada (lo cual no hice por falta de tiempo)

por ultimo aclarar que si bien es un ejempo de access,este es 'facilmente' adaptable a Excel :)

InputBoxPassword.zip

Link to comment
Share on other sites

Guest
This topic is now closed to further replies.
×
×
  • Create New...

Important Information

Privacy Policy