Ocultar contraseña en macro

Tengo un archivo al cual le inserte una macro de apertura, que al abrir me pide contraseña, pero al digitarla muestra la contraseña, ¿Cómo hago para ocultarla? ¿Cómo hago para que al abrir esta me abra en una hoja especifica?

1 Respuesta

Respuesta
1
Lo que imagino que haces es que llamas a un formulario con un textbox donde se introduce la contraseña, si es así en las propiedades de los texbox existe una que se llama passwordChar, allí colocas * si quieres que ese sea el carácter que aparezca.
Saludos Bacter...
Gracias por la ayuda, pero es que la macro la tengo montada en un modulo el cual no me muestra propiedades... ¿qué debo hacer entonces?
Carlos Andres.
Puedes enviar el código que usas.
Bacter, este es el código
Sub DefUsuario()
Dim C_Chances, C_Error, Adminis, Autoriz, Lector
Autoriz = "CLAVE"
C_Chances = 3
Application.EnableEvents = True
Application.EnableCancelKey = xlDisabled
10: ClaveX = InputBox("Por favor, ingrese su clave:", "Identificación de Usuario")
If ClaveX <> &quot;&quot; Then
Application.ScreenUpdating = False
Select Case ClaveX
Case Autoriz
Sheets(&quot;St Nuevo&quot;).Select
MsgBox &quot;Bienvenido&quot;, vbExclamation, &quot;Contraseña verificada&quot;
Case Else
Application.EnableCancelKey = xlDisabled
C_Error = C_Error + 1
If C_Error < C_Chances Then
Application.ScreenUpdating = True
MsgBox &quot;Contraseña incorrecta&quot; & Chr(10) & &quot;Ingrese nuevamente&quot; & Chr(10) & &quot;Le quedan &quot; & C_Chances - C_Error & &quot; chance&quot; & IIf(C_Chances - C_Error = 1, &quot;&quot;, &quot;s&quot;), vbInformation, &quot;ERROR en CLAVE INGRESADA&quot;
GoTo 10:
Else
Application.DisplayAlerts = False
Application.Quit
End If
End Select
Else
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = True
MsgBox &quot;No indicó clave&quot; & Chr(10) & &quot;Por lo tanto, Se cierra el archivo&quot; & Chr(10), vbInformation, &quot;NECESITA CLAVE PARA OPERAR&quot;
ActiveWorkbook.Close False
End If
Application.ScreenUpdating = True
End Sub
Saludos...
Puedes utilizar esta función de inputbox diseñada por Daniel Klann
fuente: http://www.mrexcel.com/forum/showthread.php?t=43144
La probé y me funciono de maravillas. Espero te sirva.
Hay un pequeño modulo test, para probar su funcionamiento
Saludos
Bacter
Option Explicit
&#39;////////////////////////////////////////////////////////////////////
&#39;Password masked inputbox
&#39;Allows you to hide characters entered in a VBA Inputbox.
&#39;
&#39;Code written by Daniel Klann
&#39;March 2003
&#39;////////////////////////////////////////////////////////////////////
&#39;API functions to be used
Private Declare Function CallNextHookEx Lib &quot;user32&quot; (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib &quot;kernel32&quot; Alias &quot;GetModuleHandleA&quot; (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib &quot;user32&quot; Alias &quot;SetWindowsHookExA&quot; _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib &quot;user32&quot; (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib &quot;user32&quot; Alias &quot;SendDlgItemMessageA&quot; _
(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 &quot;user32&quot; Alias &quot;GetClassNameA&quot; (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib &quot;kernel32&quot; () As Long
&#39;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
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, &quot; &quot;)
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then &#39;A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = &quot;#32770&quot; Then &#39;Class name of the Inputbox
&#39;This changes the edit control so that it display the password character *.
&#39;You can change the Asc(&quot;*&quot;) as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc(&quot;*&quot;), &H0
End If
End If
&#39;This line will ensure that any other hooks that may be in place are
&#39;called correctly.
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 Test()
Dim x
x = InputBoxDK(&quot;Type your password here.&quot;, &quot;Password Required&quot;)
If x <> &quot;yourpassword&quot; Then
MsgBox &quot;Youd didn&#39;t enter a correct password.&quot;
End If
End Sub
Amigo...
Muchas gracias por el dato, pero esta función, no permite 3 intentos, que seria necesario, ya que al momento de digitarla me puedo equivocar y realmente de esa forma quedaría muy restrangido
Gracias.
Amigo lo probé en tu código y me funciono perfectamente con 3 intentos
Solo sustituí esta linea:
10: ClaveX = InputBoxDK(&quot;Por favor, ingrese su clave:&quot;, &quot;Identificación de Usuario&quot;)
por esta linea:
10: ClaveX = InputBox(&quot;Por favor, ingrese su clave:&quot;, &quot;Identificación de Usuario&quot;)
Espero te funciones.
saludos
bacter
Sub DefUsuario()
Dim C_Chances, C_Error, Adminis, Autoriz, Lector
Autoriz = &quot;CLAVE&quot;
C_Chances = 3
Application.EnableEvents = True
Application.EnableCancelKey = xlDisabled
10: ClaveX = InputBoxDK(&quot;Por favor, ingrese su clave:&quot;, &quot;Identificación de Usuario&quot;)
If ClaveX <> &quot;&quot; Then
Application.ScreenUpdating = False
Select Case ClaveX
Case Autoriz
Sheets(&quot;St Nuevo&quot;).Select
MsgBox &quot;Bienvenido&quot;, vbExclamation, &quot;Contraseña verificada&quot;
Case Else
Application.EnableCancelKey = xlDisabled
C_Error = C_Error + 1
If C_Error < C_Chances Then
Application.ScreenUpdating = True
MsgBox &quot;Contraseña incorrecta&quot; & Chr(10) & &quot;Ingrese nuevamente&quot; & Chr(10) & &quot;Le quedan &quot; & C_Chances - C_Error & &quot; chance&quot; & IIf(C_Chances - C_Error = 1, &quot;&quot;, &quot;s&quot;), vbInformation, &quot;ERROR en CLAVE INGRESADA&quot;
GoTo 10:
Else
Application.DisplayAlerts = False
Application.Quit
End If
End Select
Else
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = True
MsgBox &quot;No indicó clave&quot; & Chr(10) & &quot;Por lo tanto, Se cierra el archivo&quot; & Chr(10), vbInformation, &quot;NECESITA CLAVE PARA OPERAR&quot;
ActiveWorkbook.Close False
End If
Application.ScreenUpdating = True
End Sub
Amigo...
No me funciona nada de esto, no se en que estoy haciendo mal..
Gracias.
Lo acabo de probar y funciona, le agregue solo una definición de variables.
Copia todo en un nuevo modulo
Una hoja del libro debe llamarse: St Nuevo
Espero que esta vez si funcione.
Option Explicit
&#39;////////////////////////////////////////////////////////////////////
&#39;Password masked inputbox
&#39;Allows you to hide characters entered in a VBA Inputbox.
&#39;
&#39;Code written by Daniel Klann
&#39;March 2003
&#39;////////////////////////////////////////////////////////////////////
&#39;API functions to be used
Private Declare Function CallNextHookEx Lib &quot;user32&quot; (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib &quot;kernel32&quot; Alias &quot;GetModuleHandleA&quot; (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib &quot;user32&quot; Alias &quot;SetWindowsHookExA&quot; _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib &quot;user32&quot; (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib &quot;user32&quot; Alias &quot;SendDlgItemMessageA&quot; _
(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 &quot;user32&quot; Alias &quot;GetClassNameA&quot; (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib &quot;kernel32&quot; () As Long
&#39;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
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, &quot; &quot;)
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then &#39;A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = &quot;#32770&quot; Then &#39;Class name of the Inputbox
&#39;This changes the edit control so that it display the password character *.
&#39;You can change the Asc(&quot;*&quot;) as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc(&quot;*&quot;), &H0
End If
End If
&#39;This line will ensure that any other hooks that may be in place are
&#39;called correctly.
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 DefUsuario()
Dim C_Chances, C_Error, Adminis, Autoriz, Lector, ClaveX
Autoriz = &quot;CLAVE&quot;
C_Chances = 3
Application.EnableEvents = True
Application.EnableCancelKey = xlDisabled
10: ClaveX = InputBoxDK(&quot;Por favor, ingrese su clave:&quot;, &quot;Identificación de Usuario&quot;)
If ClaveX <> &quot;&quot; Then
Application.ScreenUpdating = False
Select Case ClaveX
Case Autoriz
Sheets(&quot;St Nuevo&quot;).Select
MsgBox &quot;Bienvenido&quot;, vbExclamation, &quot;Contraseña verificada&quot;
Case Else
Application.EnableCancelKey = xlDisabled
C_Error = C_Error + 1
If C_Error < C_Chances Then
Application.ScreenUpdating = True
MsgBox &quot;Contraseña incorrecta&quot; & Chr(10) & &quot;Ingrese nuevamente&quot; & Chr(10) & &quot;Le quedan &quot; & C_Chances - C_Error & &quot; chance&quot; & IIf(C_Chances - C_Error = 1, &quot;&quot;, &quot;s&quot;), vbInformation, &quot;ERROR en CLAVE INGRESADA&quot;
GoTo 10:
Else
Application.DisplayAlerts = False
Application.Quit
End If
End Select
Else
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = True
MsgBox &quot;No indicó clave&quot; & Chr(10) & &quot;Por lo tanto, Se cierra el archivo&quot; & Chr(10), vbInformation, &quot;NECESITA CLAVE PARA OPERAR&quot;
ActiveWorkbook.Close False
End If
Application.ScreenUpdating = True
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Como crear una macro de inicio

Disculpa que te moleste, lo que pasa es que apenas estoy aprendiendo a manejar excel y en la escuela me dejaron un trabajo y consiste en lo siguiente: Tengo que crear una macro en la cual antes de entrar al libro ponga o muestre un formulario en...
1 respuesta

Listado de tablas de una base de datos

Me gustaría saber la forma de poder saber el nombre de todas las tablas de una base de datos de access que no sea la activa. Lo que intento es importar tablas, mediante código, de otra base de datos y necesitaría saber el nombre de toda las tablas de...
1 respuesta

Hola nuevamente, ojalá me puedas ayudar con un error en un código VB en access

El problema es que no me respetando el total de intentos al ingresar una contraseña errónea, automáticamente me saca a la primera, cuando lo debería hacer al tercer intento, aquí va el código y gracias: Option Compare Database Option Explicit Dim...
2 respuestas

Ejecutar macro si usuario es correcto.

Elaboré una pequeña macro que al abrirse el libro en forma automática desde "ThisWorkbook" ejecute la macro "verificación" que valida a uno de los usuarios, comparando con el usuario de la PC; si uno de los usuarios es correcto ejecuta la macro...
1 respuesta

Ejecutar una macro dependiendo de otra macro?

Tengo una pequeña duda... Tengo dos botones con macros uno de ellos dice IMPRIMIR y otro dice REPARTO.. Lo que quiero es que no se pueda ejecutar el botón REPARTO si no se ha impreso nada osea si no le han dado clic al botón IMPRIMIR... En el botón...
2 respuestas