Jump to content
Milton Cordova

Fromato en texto de imagen

Recommended Posts

Saludos me pueden ayudar muy comedidamente con la siguiente macro: mediante esta macro solo funciona cuando en la celda A1 ingreso manualmente al valor ya sea 1 o 0, lo que necesito es que en la celda A1 el valor venga de una formula de la celda B5.

Otra situación es cuando se ejecuta con 1 salta a la celda E7 y cuando se ejecuta con 0 salta a la celda B14, lo que deseo es que no salte ni seleccione ninguna celda.

La hoja la he protegido con una contraseña "X".

Favor analizar esta macro que he logrado

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "X"
    Application.ScreenUpdating = False

  If Not Intersect(Target, Range("A1")) Is Nothing Then
If Range("A1").Value = 1 Then
ActiveSheet.Shapes("Rectangle 1").Select
    Selection.Font.ColorIndex = 0
    ActiveSheet.Shapes("Rectangle 2").Select
    Selection.Font.ColorIndex = 0
    Range("C7").Select
    ActiveSheet.Shapes("Line 3").Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.Visible = msoTrue
ActiveSheet.Protect "X"

Else
If Range("A1").Value = 0 Then
ActiveSheet.Shapes("Rectangle 1").Select
    Selection.Font.ColorIndex = 2
    ActiveSheet.Shapes("Rectangle 2").Select
    Selection.Font.ColorIndex = 2
    Range("B14").Select
    ActiveSheet.Shapes("Line 3").Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 9
    Selection.ShapeRange.Line.Visible = msoTrue
    ActiveSheet.Protect "X"

    End If
    End If
    End If
End Sub

 

Cambia color Texto de imagenes.xls

Share this post


Link to post
Share on other sites
En 12/10/2018 at 5:06 , Milton Cordova dijo:

mediante esta macro solo funciona cuando en la celda A1 ingreso manualmente al valor ya sea 1 o 0

Lógico con el evento Change de la hoja. Tendrás que cambiar la filosofía de la macro y usar el evento

Private Sub Worksheet_Calculate()

 

Share this post


Link to post
Share on other sites
Hace 54 minutos , Haplox dijo:

Lógico con el evento Change de la hoja. Tendrás que cambiar la filosofía de la macro y usar el evento

Private Sub Worksheet_Calculate()

 

¿ Ya no nos acordamos de .DirectDependents y .DirectPrecedents ?

Share this post


Link to post
Share on other sites

Saludos Antoni disculopas por indicarte que hice el cambio pero no funciona

quiza deba ingresar algun otro evento

Private Sub Worksheet_Calcualte(ByVal Target As Range)
Application.ScreenUpdating = False

If Not Intersect(Target, Range("A1")) Is Nothing Then
If Range("A1").Value = 1 Then
ActiveSheet.Shapes("Rectangle 1").Select

.............

end sub

Gracias

 

Share this post


Link to post
Share on other sites

@Milton Cordova ¿Has visto el comentario de @Antoni ?. Usa el siguiente código
 

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect "X"

If Range("A1").DirectPrecedents = 1 Then

ActiveSheet.Shapes("Rectangle 1").Select
    Selection.Font.ColorIndex = 0
    ActiveSheet.Shapes("Rectangle 2").Select
    Selection.Font.ColorIndex = 0
    Range("C7").Select
    ActiveSheet.Shapes("Line 3").Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.Visible = msoTrue
    
ActiveSheet.Protect "X"

ElseIf Range("A1").DirectPrecedents = 0 Then
ActiveSheet.Shapes("Rectangle 1").Select
    Selection.Font.ColorIndex = 2
    ActiveSheet.Shapes("Rectangle 2").Select
    Selection.Font.ColorIndex = 2
    Range("B14").Select
    ActiveSheet.Shapes("Line 3").Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 9
    Selection.ShapeRange.Line.Visible = msoTrue
    ActiveSheet.Protect "X"

End If

End Sub

 

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png