DATOS NO MODIFICABLES E HISTÓRICO DE CAMBIOS

En este ejemplo se integran varias técnicas (procuraré ser más breve en próximos ejemplos):

* Nota: La posibilidad de que vulneren las barreras que pongamos, dependerá siempre del nivel de conocimientos y de las intenciones del usuario o intruso de turno.

Mediante un formulario VBA puedes modificar el registro anterior, para lo cual solicita usuario y contraseña. Si realizas algún cambio, guardará en un histórico los cambios realizados, quien los realizó y en qué fecha y hora.






En caso de no reconocer el usuario escrito o la contraseña, mostrará un mensaje de advertencia y sólo permitirá cancelar la operación.

En la Hoja Histórico hay una tabla con los usuarios y contraseñas autorizados/as.

Las columnas con las contraseñas podrían esta ocultas, también podrías ocultar la hoja mediante VBA (VeryHidden), tener los usuarios y contraseñas en una matriz o en constantes, etc.







Puedes visualizar / comparar cualquiera de los cambios con el registro que existía anteriormente al cambio, haciendo clic en una de las celdas con cambios de la hoja Histórico (en el recuadro gris; las celdas claras).




Proceso:



Codigo VBA.

En un módulo ordinario.
Sub LlamaFormMod()
UserFormModif.Show
End Sub

En el módulo de la hoja Principal.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fila%
fila = Target.Row
If Target.Column = 6 Then ' Columna IGIC.
If Target.Cells.Count > 1 Then Exit Sub ' Selección múltiple.
Application.EnableEvents = False 'Desactivo los eventos.
' modo porcentaje.
If Target > 1 Then Target.Value = Target / 100
Selection.NumberFormat = "0.00%" Application.EnableEvents = True ' Activo los eventos.
End If ' Cambia a la siguiente celda de entrada de datos.
Select Case Target.Column
Case 1
ActiveSheet.ScrollArea = Cells(fila, 2).Address
Case 2 ActiveSheet.ScrollArea = Cells(fila, 3).Address
Case 3 ActiveSheet.ScrollArea = Cells(fila, 4).Address
Case 4 ActiveSheet.ScrollArea = Cells(fila, 6).Address
Case 6 ActiveSheet.ScrollArea = Cells(fila + 1, 1).Address
End Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then ' Selección múltiple.
Cells(25, 1).End(xlUp).Offset(1).Select ' Próxima celda libre en A.
ActiveSheet.ScrollArea = ActiveCell.Address ' Única celda seleccionable.
Exit Sub
End If
' Única celda seleccionable.
If Target.Value <> "" Then ActiveSheet.ScrollArea = Cells(25, 1).End(xlUp).Offset(1).Address
End Sub

En el módulo de la hoja Histórico.
Private Sub Worksheet_Activate()
[A2].Select ' selecciono una celda fuera del histórico.
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column > 5 Then ' Si es una modificación.
If ActiveCell.Value = Empty Then Exit Sub ' Si la celda está vacia: termina.
' Muestra la compartiva.
MsgBox ActiveCell.Offset(0, -1).Value & vbCr & vbCr & ActiveCell.Value, vbInformation, "Comparativa de cambios."
End If
End Sub

En el módulo del formulario.
Option Explicit
Public intUsuario%, intPasw%, intCambio%

Private Sub UserForm_Initialize()
intCambio = 0
End Sub

Private Sub TextBoxFecha_Change()
intCambio = intCambio + 1 ' Ha habido cambios.
End Sub

Private Sub TextBoxConcepto_Change()
intCambio = intCambio + 1 ' Ha habido cambios.
End Sub

Private Sub TextBoxCU_Change()
intCambio = intCambio + 1 ' Ha habido cambios.
End Sub

Private Sub TextBoxPrecio_Change()
intCambio = intCambio + 1 ' Ha habido cambios.
End Sub

Private Sub TextBoxIgic_Change()
intCambio = intCambio + 1 ' Ha habido cambios.
End Sub

Private Sub CommandButtonAceptar_Click()
If intCambio > 0 Then historico ActiveCell.Row - 1 ' Registra los cambios.
Unload UserFormModif ' Descarga el formulario.
End Sub

En el módulo del formulario (continuación).

Private Sub CommandButtonCancelar_Click()
' Descarga el formulario.
Unload UserFormModif
End Sub

Private Sub TextBoxPasword_Change()
On Error GoTo Salir ' Si no existe la contraseña; finaliza.
intPasw = Application.WorksheetFunction.Match (UserFormModif.TextBoxPasword.Text, Sheets(2).Range("C4:C12"), 0)
Exit Sub
Salir:
intPasw = 0
End Sub

Private Sub TextBoxPasword_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If intUsuario > 0 And intUsuario = intPasw Then
' Muestra los datos modificables.
RegAnterior ActiveCell.Row - 1
Else
' Muestra mensaje de error.
UserFormModif.LabelNoAcceso.Visible = True
End If
' Desactiva los cuadros de texto: Usuario y contraseña.
UserFormModif.TextBoxUsuario.Enabled = False
UserFormModif.TextBoxPasword.Enabled = False
End Sub

Private Sub TextBoxUsuario_Change()
On Error GoTo Salir
intUsuario = Application.WorksheetFunction.Match (UserFormModif.TextBoxUsuario.Text, Sheets(2).Range("B4:B12"), 0)
Exit Sub
Salir:
intUsuario = 0
End Sub

Private Sub RegAnterior(fila As Integer)
UserFormModif.TextBoxFecha.Value = Sheets(1).Cells(fila, 1).Value
UserFormModif.TextBoxConcepto.Value = Sheets(1).Cells(fila, 2).Value
UserFormModif.TextBoxCU.Value = Sheets(1).Cells(fila, 3).Value
UserFormModif.TextBoxPrecio.Value = Sheets(1).Cells(fila, 4).Value
UserFormModif.TextBoxIgic.Value = Sheets(1).Cells(fila, 6).Value
UserFormModif.CommandButtonAceptar.Enabled = True
UserFormModif.TextBoxFecha.Enabled = True
UserFormModif.TextBoxConcepto.Enabled = True
UserFormModif.TextBoxCU.Enabled = True
UserFormModif.TextBoxPrecio.Enabled = True
UserFormModif.TextBoxIgic.Enabled = True
intCambio = 0
End Sub

Private Sub historico(fila As Integer)
' Declaración de variables.
Dim strHistorico$, fecha As Date, valor As Double
Application.EnableEvents = False
If Sheets("Histórico").Cells(fila, 5).Value = "" Then Sheets("Histórico").Cells(fila, _
5).Value = Cells(fila, 1).Value & ">" & Cells(fila, 2).Value & ">" & Cells(fila, _
3).Value & ">" & Cells(fila, 4).Value & ">" & Cells(fila, 6).Value
strHistorico = Format(Date, "dd-mm-yy") & Format(Time, " hh:mm >") & _
UserFormModif.TextBoxUsuario.Text & ": " & UserFormModif.TextBoxFecha.Text & ">" _
& UserFormModif.TextBoxConcepto.Text & ">" & UserFormModif.TextBoxCU.Text & ">" _
& UserFormModif.TextBoxPrecio.Text & ">" & UserFormModif.TextBoxIgic.Text
Sheets("Histórico").Cells(fila, 200).End(xlToLeft).Offset(, 1).Value = strHistorico
fecha = DateSerial(Val(Right(UserFormModif.TextBoxFecha.Value, 4)), Val(Mid(UserFormModif _
.TextBoxFecha.Value, 4, 4)), Val(Left(UserFormModif.TextBoxFecha.Value, 2)))
ActiveSheet.Range("A" & fila).Value = fecha
ActiveSheet.Range("B" & fila).Value = UserFormModif.TextBoxConcepto.Value
valor = UserFormModif.TextBoxCU.Value
ActiveSheet.Range("C" & fila).Value = valor
valor = UserFormModif.TextBoxPrecio.Value
ActiveSheet.Range("D" & fila).Value = valor
valor = UserFormModif.TextBoxIgic.Value
ActiveSheet.Range("F" & fila).Value = valor
Sheets("Principal").ScrollArea = Range("A" & fila + 1).Address
ActiveSheet.Range("A" & fila + 1, "D" & fila + 1).ClearContents
ActiveSheet.Range("F" & fila + 1).ClearContents
Application.EnableEvents = True
End Sub




Volver arriba