Bloquear celdas menos una después de registro
¿Cómo están?, tengo una macro que me pide una contraseña al abrir el libro y si pongo correctamente la contraseña me deja acceder al libro y lo registra en una hoja, con el nombre de usuario de PC y serie de disco duro. Hasta aquí todo perfecto pero me gustaría que este libro solo se pueda usar en una sola computadora, al dar la contraseña lo podrían utilizar en N computadoras ya que se seguiría registrando, a lo cual se me ocurrió bloquear todas las demás celdas menos la que tiene el primer registro y en caso de que intenten registrar otra maquina el libro se cierre. La macro es la siguiente :
Dim CerrarFormulario As Boolean
Private Sub UserForm_QueryClose(Cancel As Integer, ModoCerrar As Integer)
'EVITO QUE EL USUARIO DE A LA (X) DEL FORMULARIO PARA CERRARLO Y OBLIGO A QUE INSERTE UNA CONTRASEÑA.
If CerrarFormulario = False Then Cancel = True
End Sub
Private Sub txtPassword_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim SerialHD As String
Dim UltRegistro As Integer
If KeyCode = 13 Then
With CreateObject("Scripting.FileSystemObject")
SerialHD = Hex(.Drives.Item("C:").SerialNumber)
End With
UltRegistro = Hoja2.Range("B" & Rows.Count).End(xlUp).Row
'EL USUARIO A PULSADO LA TECLA ENTER
If Len(txtPassword) > 0 Then
If txtPassword = "Dr4gonnike01" Then
msg = MsgBox("¿Desea insertar al siguiente Usuario al listado de Autorizados?" & vbCrLf & vbCrLf & "Usuario: " & SerialHD, vbQuestion + vbYesNo, "Autorizaciones")
If msg = vbYes Then
If UltRegistro > 2 Then
Hoja2.Range("B" & UltRegistro + 1) = SerialHD 'SERIAL DEL DISCO DURO
Hoja2.Range("C" & UltRegistro + 1) = Environ("username") 'NOMBRE DE USUARIO
Else
Hoja2.Range("B3") = SerialHD 'SERIAL DEL DISCO DURO
Hoja2.Range("C3") = Environ("username") 'NOMBRE DE USUARIO
End If
CerrarFormulario = True
Unload Me
Else
CerrarFormulario = True
Unload Me 'CIERRO EL FORMULARIO
End If
Else
CerrarFormulario = True
Unload Me 'CIERRO EL FORMULARIO
ThisWorkbook.Close False 'CIERRO EL PROGRAMA SIN GUARDAR LOS CAMBIOS
End If
End If
End If
End Sub
1 respuesta
H o l a:
La siguiente puede ser una opción.
Si solamente quieres que se utilice en una computadora, entonces pon el número de serie dentro del código del formulario, si el número de serie de la computadora es igual número de serie que tiene el formulario, entonces que te permita usar el libro, de lo contrario, que se cierre el libro.
El código quedaría simplificado a esto:
Dim CerrarFormulario As Boolean
'
Private Sub UserForm_QueryClose(Cancel As Integer, ModoCerrar As Integer)
'evito que el usuario de a la (x) del formulario para cerrarlo y obligo a que inserte una contraseña.
If CerrarFormulario = False Then Cancel = True
End Sub
'
Private Sub txtPassword_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'Act.Por.Dante Amor
If KeyCode <> 13 Then Exit Sub
If txtPassword <> "Dr4gonnike01" Then ThisWorkbook.Close False
SerialHD = Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C:").SerialNumber)
If SerialHD <> "FCC63D85" Then ThisWorkbook.Close False
'
CerrarFormulario = True
Unload Me 'CIERRO EL FORMULARIO
End SubCambia en la macro "FCC63D85", por el número de serie de la computadora donde quieres utilizar el libro.
Para mayor seguridad, deberás proteger el código VBA con contraseña, para eso entra a al menú de VBA, Herramientas, Propiedades de VBAProject, Protección, Activa la casilla "Bloquear proyecto para visualizar", escribe una Contraseña, Confirma la contraseña y Aceptar.
me parece muy buena la idea, pero la idea seria pasarle el archivo sin ningun registro. osea sin haber registrado ninguna maquina y que al abrirlo en dicha computadora esa sea la primera. ahora si lo quiere copiar ya no podra utilizarlo dado que solo permita el registro de una sola computadora.
muchas gracias por su colaboracion "Dante Amor"
o en ultimo caso, seria bueno saber como obtener el numero de serie de la computadora para que el archivo lo pueda pasar y hacer los ajustes en ese momento que este copiando el archivo a dicha computadora.
Gracias
H o l a:
Si tu le das el archivo con la hoja2 en blanco, entonces puede tomar ese archivo y copiarlo.
Si tu vas a hacer la instalación del archivo, entonces puedes tomar el número de serie ejecutando esta macro:
Sub serial()
MsgBox Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C:").SerialNumber)
End SubEntonces apuntas el número de serie que te aparece en el mensaje, lo pones en la macro, proteges las macros y guardas el archivo.
