Anónimo
Como proteger unas celdas después de capturar un dato
Acudo a ti para ver si me puedes ayudar con una cosa me encontré con un archivo el cual maneja la entrada y salida del personal funciona perfecto, pero necesito que al momento del registro de la entrada o salida del personal quede bloqueado el registros de fecha y hora para que no puedan ser manipulados me encontré con un enlace tuyo pero no me funciono por favor necesito de tu ayuda
En esta imagen se busca el funcionario y se pincha el botón de entrada o salida según sea el caso en el caso del botón de entrada registra los datos consecutivamente a partir de la columna B7 en esta registra el código, en la C7 registra Nombre, en la D7 registra la Entrada y en la E 7 registra la salida y en la columna F7 hace la conveersion del tiempo realizando la resta entre la entrada y salida de ahí en adelelante identifica las celdas en blanco y realiza la adición de los registros,
Este es el código que utiliza
Sub Add_Control()
Dim miCelda As Range
Dim FilaLibre As Long
Dim tipoMov As String
Set miCelda = [datos]
FilaLibre = ActiveSheet.Cells(65536, miCelda.Column).End(xlUp).Row + 1
tipoMov = Application.Caller
If tipoMov = "bEntrada" Then
FilaLibre = ActiveSheet.Cells(65536, miCelda.Column).End(xlUp).Row + 1
ActiveSheet.Cells(FilaLibre, miCelda.Column).Value = [codemp]
ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 1).Value = [nomemp]
ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 2).Value = Now()
Else
Do While FilaLibre > [datos].Row
FilaLibre = FilaLibre - 1
If ActiveSheet.Cells(FilaLibre, miCelda.Column).Value = [codemp] Then
If ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 3).Value = "" Then
ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 3).Value = Now()
Exit Do
End If
End If
Loop
End If
End Sub
1 Respuesta
H o l a: Para que una celda se pueda bloquear, tienes que proteger la hoja.
Primero, selecciona todas las celdas, entra al menú Inicio, Formato, Formato de Celdas, Proteger y desactiva la casilla de Bloqueada.
Ahora actualiza la macro, cambia el passwor "abc" por la palabra que desees. Presiona el botón de entrada para que se actualice el registro, automáticamente quedarán bloqueadas las celdas.
Sub Add_Control() Dim miCelda As Range Dim FilaLibre As Long Dim tipoMov As String Set miCelda = [datos] FilaLibre = ActiveSheet.Cells(65536, miCelda.Column).End(xlUp).Row + 1 tipoMov = Application.Caller ActiveSheet.Unprotect "abc" If tipoMov = "bEntrada" Then FilaLibre = ActiveSheet.Cells(65536, miCelda.Column).End(xlUp).Row + 1 ActiveSheet.Cells(FilaLibre, miCelda.Column).Value = [codemp] ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 1).Value = [nomemp] ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 2).Value = Now() ActiveSheet.Cells(FilaLibre, miCelda.Column).Locked = True ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 1).Locked = True ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 2).Locked = True Else Do While FilaLibre > [datos].Row FilaLibre = FilaLibre - 1 If ActiveSheet.Cells(FilaLibre, miCelda.Column).Value = [codemp] Then If ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 3).Value = "" Then ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 3).Value = Now() ActiveSheet.Cells(FilaLibre, miCelda.Column).Offset(0, 3).Locked = True Exit Do End If End If Loop End If ActiveSheet.Protect "abc" End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias