Problema evento Private Sub Worksheet_Change(ByVal Target As Range)
Los expertos: Tengo el siguiente problema. Tengo un libro con un Userform desde el que con un combobox selecciono otro libro y mediante Cbt lo abro(en el código de apertura lo desprotego para abrirlo), cerrando el primero.
En este nuevo libro, en una de las hojas, en la que hay fórmulas en algunas celdas,(no hay ningún formato condicional en ninguna celda), tengo en el evento Private Sub Worksheet_Change(ByVal Target As Range), el siguiente código:
Option Explicit
---------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'SOMBREAR CELDAS AL INTRODUCIR VALOR
Application.ScreenUpdating = False
Dim KeyCells As Range
Dim c As Excel.Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("I13:EC379")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
For Each c In Target
If UCase(c.Value) <> "0" Then
c.Interior.Color = RGB(191, 191, 191)
End If
If UCase(c.Value) = "" Then
c.Interior.Color = xlNone
End If
Next
End If
Application.ScreenUpdating = True
End Sub
El tema es que al introducir valores en las celdas desprotegidas, no se sombrean según el código anterior.
Ahora viene lo más curioso. Si abro el segundo libro en cuestión directamente, sin usar el userform del original, me pide : contraseña de apertura y activar macros.
Una vez en este accedo a la hoja deseada y al introducir datos en las celdas, si se sombrean.
Donde puede estar el problema. Muchas gracias de antemano.
Código del primer libro con el que abro el segundo:
Private Sub CommandButton13_Click()
'ABRIR PLANIFICACION DE LA OBRA
Application.ScreenUpdating = False
If ComboBox7.Value = "" Then
MsgBox "Debe seleccionar una obra"
ComboBox7.SetFocus
End If
If ComboBox7.Value <> "" Then
Dim wbDestino As Workbook 'SEO GMI
Dim wbOrigen As Workbook 'Certificacion
Dim wsOrigen As Excel.Worksheet
Set wbDestino = ActiveWorkbook 'SEO GMI
fichero = Label31.Caption & "\" & "Certificacion.xlsm"
Application.EnableEvents = False
Application.Workbooks.Open (fichero), Password:="fernan"
Application.EnableEvents = True
Set wbOrigen = ActiveWorkbook 'Certificacion
Worksheets("Certificacion").Unprotect ("fernan")
wbDestino.Activate
Worksheets("GMI").Select
Range("C2").Select
Selection.Copy
Workbooks("Certificacion").Activate
Worksheets("Certificacion").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Workbooks("Certificacion").Activate
Set wsOrigen = Worksheets("Datos Obra")
Worksheets("Datos Obra").Visible = True
Worksheets("Datos Obra").Select
If Range("K24") = Range("G26") Then
archivo = Label31.Caption & "\" & "Planificacion.xlsm"
'Application.EnableEvents = False
Application.Workbooks.Open (archivo), Password:="fernan"
'Application.EnableEvents = True
Worksheets("Planificacion").Unprotect ("fernan")
wbDestino.Activate 'SEO GMI
Worksheets("GMI").Select
Range("C2").Select
Selection.Copy
Workbooks("Planificacion").Activate
Worksheets("Planificacion").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Worksheets("Planificacion").Protect ("fernan")
ActiveWorkbook.Save 'Planificacion
Set wsOrigen = Worksheets("Datos Obra")
Worksheets("Datos Obra").Visible = False 'Certificacion Hoja "Datos Obra"
Application.DisplayAlerts = False
Application.EnableEvents = False
Workbooks("Certificacion"). Save 'Certificacion
Workbooks("Certificacion").Close 'Certificacion
Workbooks("SEO GMI").Save 'SEO GMI
Workbooks("SEO GMI").Close 'SEO GMI
Application.EnableEvents = True
UserForm1.Hide
End If
If Range("K24") <> Range("G26") Then
MsgBox "Antes de abrir la Planificacion, debe grabar el P.Contradictorio en la Certificacion", vbInformation, "GMI Construcción"
Application.EnableEvents = False
Worksheets("Datos Obra").Visible = False
Workbooks("Certificacion").Save 'Certificacion
Workbooks("Certificacion").Close 'Certificacion
Application.EnableEvents = True
CommandButton15.BackColor = &HCCCCFF
CommandButton15.SetFocus
End If
End If
Application.ScreenUpdating = True
End Sub