Untitled

Option Explicit


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim rngLockedCells As Range
    Dim rngX As Range
    Dim strPWD As String
    Dim strCodigo As String
    Dim strOldValue As String
    Dim strTimeStamp As String
    Dim strChangedCell As String
    Dim strUser As String
    Dim strPwdReply As String
    Dim strComment As String
    Dim strCellComment As String
    Dim varNewCellValue As String
    Dim frmPWD As UserForm1
    
    strPWD = "123"
    strCodigo = "JuanTrodat1514"
    
    Set rngLockedCells = ActiveSheet.Range("rngLockedCells")
    Set rngX = Intersect(rngLockedCells, Target)
    If rngX Is Nothing Then Exit Sub
    
    'Restrict the change only to 1 single cell
    If (rngX.Columns.Count = 1) And _
        (rngX.Rows.Count = 1) Then
        
        'Prompt if user wants to change cell value
        If MsgBox("Quiere modificar la celda '" & rngX(1, 1).Address & "'?", vbOKCancel, "Modificar celda") = vbOK Then
            
            'Get PWD with Form
            Set frmPWD = New UserForm1
            
            'Set up the Password TextBox
           Dim txtPassword As New TextBox
            txtPassword.Name = "PasswordBox"
            txtPassword.Width = 100
            txtPassword.Height = 20
            txtPassword.Top = 10
            txtPassword.Left = 10
            txtPassword.PasswordChar = "*"
            frmPWD.Controls.Add (txtPassword)
            
            'Set up the Password Label
          Dim lblPassword As New Label
            lblPassword.Name = "PasswordLabel"
            lblPassword.Text = "Contraseña:"
            lblPassword.Top = 10
            lblPassword.Left = 120
            frmPWD.Controls.Add (lblPassword)
            
            'Show the form
            frmPWD.Show
            
            'Get the password
            strPwdReply = frmPWD.Controls("PasswordBox").Value
            strComment = strPwdReply
            
            'Unload the form
            Unload frmPWD
            
            'check if password is correct
            If strCodigo = strPwdReply Then
                
                'Unlock the cell to allow user to change value
                
                Target.Worksheet.Unprotect password:=strPWD
                rngX.Locked = False
                
                'Get values for Log
                strOldValue = rngX.Value
                strTimeStamp = Now()
                strChangedCell = rngX.Address
                strUser = Application.UserName
                Debug.Print "strOldValue: " & strOldValue
                Debug.Print "strTimeStamp:" & strTimeStamp
                Debug.Print "strChangedCell: " & strChangedCell
                Debug.Print "strUser: " & strUser
                Debug.Print "strComment: " & strComment
                
                strComment = strTimeStamp & "/" & strUser & ": editó valor '" & strOldValue & "' - Razón: '" & strComment & "'"
                    Debug.Print strComment
                   
                    'Modify comment in cell
                    On Error Resume Next
                    strCellComment = rngX.Comment.Text
                    On Error GoTo 0

                    'If comment exists then display message box
                    If strCellComment <> "" Then
                    
                        'Add new comment to old comment
                        strCellComment = strCellComment & vbNewLine & strComment
                    
                    Else
                        'Add comment
                        rngX.AddComment
                        strCellComment = strComment
                    End If

                    'Update the cell comment
                    rngX.Comment.Text Text:=strCellComment
                    rngX.Comment.Shape.TextFrame.AutoSize = True
                                   
                    Target.Worksheet.Protect password:=strPWD
                   
                Else
                    MsgBox "Access denied", vbCritical
                End If
                
                'do not show right click menu
                Cancel = True
            End If
           
           
        End If

Set rngLockedCells = Nothing

End Sub

'Private Sub Worksheet_Change(ByVal Target As Range)
'    If Target.Column < 26 Then
'        Cells(Target.Row, 27).Value = Now()
'        Cells(Target.Row, 28).Value = Application.UserName
'    End If
'End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngLockedCells As Range
Dim rngX As Range
Dim strPWD As String

strPWD = "123"

Set rngLockedCells = ActiveSheet.Range("rngLockedCells")
Set rngX = Intersect(rngLockedCells, Target)
        If rngX Is Nothing Then Exit Sub

        Target.Worksheet.Unprotect password:=strPWD
        rngX.Locked = True
        Target.Worksheet.Protect password:=strPWD

Set rngLockedCells = Nothing


End Sub

Sub test()
Hoja3.Range("A2").Value2 = "02/04/2022"

End Sub