NO me funciono :c, ¿en el evento de la hoja tengo esto crees que este afectando?
Private Sub Worksheet_Activate()
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
ActiveSheet.ScrollArea = "B1:CN820"
ActiveSheet.Range("D6:E790").NumberFormat = "GENERAL"
ActiveSheet.Range("G6:H790").NumberFormat = "GENERAL"
ActiveSheet.Range("J6:M790").NumberFormat = "GENERAL"
ActiveSheet.Range("O6:BN790").NumberFormat = "GENERAL"
Application.ExecuteExcel4Macro "show.toolbar(""ribbon"",FALSE)"
ActiveSheet.Protect ''AQUI CONTRASEÑA
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("D6:BN790")) Is Nothing Then
For Each D In Target
If D.Value <> "" Then
If Not IsNumeric(D.Value) Then
Application.EnableEvents = False
D.Value = ""
D.Select
celda = celda & D.Address & " "
datoerrD = True
Application.EnableEvents = True
End If
End If
Next
If datoerrD Then
MsgBox "Intentaron poner letras en las celdas " & celda, vbexclamantion, "NO PERMITIDO"
End If
End If
'************************
Application.ScreenUpdating = False
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
'Act.Por.Dante Amor
If Not Application.Intersect(Target, Range("j6:j790")) Is Nothing Then
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
If Range("J1") = "" Then
MsgBox " Se te olvida la Hora base de: " & Range("j2"), vbOKOnly + vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Else
If Cells(Target.Row, "E") = "" Then
MsgBox " Se te olvida el pedido : " & Cells(Target.Row, "B").Value, vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Exit Sub
End If
Range("BR" & Target.Row) = Date
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
Range("BQ" & Target.Row) = Range("j1")
End If
End If
'***************************
Application.ScreenUpdating = False
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
'Act.Por.Dante Amor
If Not Application.Intersect(Target, Range("K6:K790")) Is Nothing Then
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
If Range("K1") = "" Then
MsgBox " Se te olvida la Hora base de: " & Range("K2"), vbOKOnly + vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Else
If Cells(Target.Row, "E") = "" Then
MsgBox " Se te olvida el pedido : " & Cells(Target.Row, "B").Value, vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Exit Sub
End If
Range("BV" & Target.Row) = Date
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
Range("BU" & Target.Row) = Range("K1")
End If
End If
'***************************
Application.ScreenUpdating = False
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
'Act.Por.Dante Amor
If Not Application.Intersect(Target, Range("L6:L790")) Is Nothing Then
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
If Range("L1") = "" Then
MsgBox " Se te olvida la Hora base de: " & Range("L2"), vbOKOnly + vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Else
If Cells(Target.Row, "E") = "" Then
MsgBox " Se te olvida el pedido : " & Cells(Target.Row, "B").Value, vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Exit Sub
End If
Range("BZ" & Target.Row) = Date
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
Range("BY" & Target.Row) = Range("L1")
End If
End If
'***************************
Application.ScreenUpdating = False
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
'Act.Por.Dante Amor
If Not Application.Intersect(Target, Range("M6:M790")) Is Nothing Then
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
If Range("M1") = "" Then
MsgBox " Se te olvida la Hora base de: " & Range("M2"), vbOKOnly + vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Else
If Cells(Target.Row, "E") = "" Then
MsgBox " Se te olvida el pedido : " & Cells(Target.Row, "B").Value, vbExclamation, "ALTO"
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
Exit Sub
End If
Range("CD" & Target.Row) = Date
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
Range("CC" & Target.Row) = Range("M1")
End If
End If
ActiveSheet.Unprotect ''AQUI CONTRASEÑA
ActiveSheet.Range("D6:E790").NumberFormat = "GENERAL"
ActiveSheet.Range("G6:H790").NumberFormat = "GENERAL"
ActiveSheet.Range("J6:M790").NumberFormat = "GENERAL"
ActiveSheet.Range("O6:BN790").NumberFormat = "GENERAL"
ActiveSheet.Range("j1:m1").NumberFormat = "h:mm AM/PM"
ActiveSheet.Protect ''AQUI CONTRASEÑA
End Sub
Me sigue saliendo la hoja con fecha atrasada y con 3 años atrás