Macro para colorir shapes.

2024 - VBA & Macros

Post Recente por TioDan 10 anos atrás

3 Posts

2 Usuários

0 Reactions

1,271 Visualizações

RSS

TioDan

(@tiodan)

Posts: 2

New Member

Topic starter

Boa tarde a todos.
Eu pesquisei o assunto no fórum porém não consegui encontrar uma solução que adequasse ao meu problema.
Eu preciso de uma macro para alterar a cor de uma shapes quando ela é selecionada (clicada), e voltar a cor anterior quando anterior quando ela não esta mais selecionada.
A cor original de cada shapes é cinza, quando clicada ela passa a ser laranja, e quando eu seleciono outra shapes esta primeira volta a ser cinza novamente.
Eu estruturei um código porém onde o primeiro formatação acontece porém o segundo não, segue abaixo:

Sub Retângulodecantosarredondados6_Clique()

If Range("G19").Value <> "F" Then
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 8")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(226, 107, 10)
.Transparency = 0
.Solid
End With

ElseIf Range("G19").Value = "F" Then
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 8")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(89, 89, 89)
.Transparency = 0
.Solid
End With
End If

Range("G19").Select
Range("G19") = "F"
End Sub

Postado : 09/04/2015 10:18 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Boa tarde!!

Use uma célula para receber um valor

Sub Amarelo()
    Dim shp1 As Shape
    Set shp1 = ActiveSheet.Shapes("Rectangle 1")
    shp1.Fill.ForeColor.RGB = RGB(255, 255, 0)
    [A1].Value = "Cinza"
End Sub
Sub Cinza()
    Dim shp1 As Shape
    Set shp1 = ActiveSheet.Shapes("Rectangle 1")
    shp1.Fill.ForeColor.RGB = RGB(128, 128, 128)
    [A1].Value = "Amarelo"
End Sub
Sub Retângulo1_Clique()
    If Range("A1").Value = "Amarelo" Then
        Call Amarelo
    Else
        Call Cinza
    End If
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 09/04/2015 11:32 am