Dos eventos en una misma hoja

Hola, tengo los siguientes códigos en una hoja

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Target.Address = "$C$1" Then
 Call EDITARREGISTROS1
 ElseIf Target.Address = "$E$1" Then
 Call EDITARREGISTROS2
 End If
End Sub

    Dim Celda As Range
    Dim Rango As Range
    Range("D1").Select
    Set Rango = Selection
    For Each Celda In Rango
    'si la celda está en color rojo
    If Celda.Interior.Color = RGB(255, 0, 0) Then
    'Ejecuta macro
    Call ALERTA_DE_EDICION
    Else
    Exit Sub
    End If
    Next

y quisiera incluir en la misma hoja la siguiente macro

Pero no lo logro ya que al ponerlas juntas, el segundo evento no se detiene y tendría que dejar de ejecutarse si cambio de color la celda.

2 Respuestas

Respuesta
1

¿Cuál es la siguiente macro? Es esta:

Dim Celda As Range
Dim Rango As Range
Range("D1").Select
Set Rango = Selection
For Each Celda In Rango
'si la celda está en color rojo
If Celda.Interior.Color = RGB(255, 0, 0) Then
'Ejecuta macro
Call ALERTA_DE_EDICION
Else
Exit Sub
End If
Next

Quieres incluir la macro en el mismo evento beforedoubleclick?

¿Cuál es el segundo evento? Dices: "el segundo evento no se detiene y tendría que dejar de ejecutarse si cambio de color la celda."

Si quieres que los eventos no se ejecuten tienes que poner la siguiente instrucción

Application.EnableEvents = False

'tú código

'...

'Después tienes que habilitar nuevamente los eventos para que se active, por ejemplo el evento, beforedoubleclick

Application.EnableEvents = True

Podrías ser así:

Application.EnableEvents = False
    Range("D1").Select
    Set Rango = Selection
    For Each Celda In Rango
    'si la celda está en color rojo
    If Celda.Interior.Color = RGB(255, 0, 0) Then
    'Ejecuta macro
    Call ALERTA_DE_EDICION
    Else
    Exit Sub
    End If
    Next
Application.EnableEvents = True

Prueba y me comentas, si tienes dudas avísame y lo revisamos.

Esta es el código completo,

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Target.Address = "$C$1" Then
 Call EDITARREGISTROS1
 ElseIf Target.Address = "$E$1" Then
 Call EDITARREGISTROS2
 End If
    Dim Celda As Range
    Dim Rango As Range
    Range("D1").Select
    Set Rango = Selection
    For Each Celda In Rango
    'si la celda está en color rojo
    If Celda.Interior.Color = RGB(255, 0, 0) Then
    'Ejecuta macro
    Call ALERTA_DE_EDICION
    Else
    Application.EnableEvents = False
    Exit Sub
    End If
    Next
End Sub

Lo primero que hace es valorar si doy doble click en la celda "C1" ejecuta la macro "EDITARREGISTROS1" (desprotege la hoja), si doy doble click en la celda "E1" ejecuta la macro "EDITARREGISTROS2" (proteje la hoja) ahora bien, si al ejecutarse la primera macro, esta tarda 1 minuto corriendo (desproteguida la hoja) automaticamente me despliega una alerta en donde me pregunta si deseo seguir editando (hoja desprotegida) o finalizo la edición  (hoja protegida), el detalle es que cuando le indico que deseo finalizar , no termina la rutina, sigue enviando la alerta.

Lo que no veo es en qué momento revisas que lleva un minuto la hoja desprotegida.

También puedes poner todas las macros, EDITARREGISTROS1, EDITARREGISTROS2 y ALERTA_DE_EDICION

También explícame por qué revisas el color de la celda "D1"

Claro, anexo las macros solicitadas.

Sub ALERTA_DE_EDICION()
Dim ComienzoSeg As Single
Dim FinSeg As Single
Dim R As Double
R = 0
TIEMPO_ESP_MAX = 60 'ESTABLECES EL TIEMPO DE ESPERA EN SEGUNDOS
Do While R = O
'
ComienzoSeg = Timer
FinSeg = ComienzoSeg + TIEMPO_ESP_MAX
Do While FinSeg > Timer
DoEvents
TChecq1 = Round(FinSeg - Timer, 0)
If TChecq1 <> TChecq2 Then
TChecq2 = TChecq1
End If
If ComienzoSeg > Timer Then
FinSeg = FinSeg - 24 * 60 * 60
End If
Loop
'AQUI COLOCAS EL CODIGO QUE QUIERES EJECUTAR CADA n SEGUNDOS
Call EDITAR
Loop
End Sub
Sub EDITAR()
Dim Resp As Byte
Resp = MsgBox("Desea Finalizar la Edición de Registros?", _
    vbQuestion + vbYesNo, "EDICION DE LOGISTICAS")
If Resp = vbYes Then
Call CAMBIARAEDITARYFINALIZAR1
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
ActiveSheet.Unprotect
End If
Exit Sub
End Sub
Sub EDITARREGISTROS1()
ActiveSheet.Unprotect
Call CAMBIARAEDITANDOYFINALIZAR1
End Sub
Sub EDITARREGISTROS2()
Call CAMBIARAEDITARYFINALIZAR2
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub CAMBIARAEDITANDOYFINALIZAR1()
'ESCONDE EDITAR
    Range("C1").Select
    Range("C1").Activate
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
'ACTIVA EDITANDO
        Range("D1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
 'ACTIVA FINALIZAR
        Range("E1").Select
     With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("A2").Select
End Sub
Sub CAMBIARAEDITARYFINALIZAR2()
    'ACTIVA EDITAR Y ESCONDE EDITANDO Y FINALIZAR
    Range("D1,E1").Select
    Range("E1").Activate
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.249977111117893
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("C1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("A2").Select
End Sub

Bueno, basicamente lo que deseo hacer es que si la celda "C1" esta en rojo me arroje una alerta despues de 1 minuto preguntando si deseo seguir editando o finalizo la edición y si elijo la primera opción sencillamente me deje desprotegida la hioja y si elijo segunda opción me proteja la hoja y finalice.

excelente ya lo solucione cambiando esta instrucción en la macro ALERTA_DE_EDICION:

Do While Sheets("PROGRAMA").Range("C1").Value <> "EDITAR FOLIOS"

Agradezco de antemano la valiosa ayuda para llegar a esta solución.

Qué bien.

Podrías valorar esta respuesta.

Respuesta
1

No indicas si la 2da macro también necesitas ejecutarla al doble clic en alguna celda, pero si es en la D1 sería algo así:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Target.Address = "$C$1" Then
     Call EDITARREGISTROS1
 ElseIf Target.Address = "$E$1" Then
     Call EDITARREGISTROS2
 ElseIf Target.Address = "$D$1" Then
     'el código que necesitas para D1
End If
End Sub

Noto un posible error en la 2da macro. Observa:

Range("D1").Select
    Set Rango = Selection
    For Each Celda In Rango

Si 'Rango' es D1 no es necesario el bucle para recorrer Rango, ya que es 1 sola celda... quizás debas revisar esa macro o explicar un poco más qué intentas hacer con la 2da rutina.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas