Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Alterar cor formas ...
 
Notifications
Clear all

Alterar cor formas - "Procedimento muito grande"

 
2024 - VBA & Macros
Post Recente por edilsonfl 8 anos atrás
3 Posts
3 Usuários
0 Reactions
1,294 Visualizações
RSS
 nepow
(@nepow)
Posts: 14
Active Member
Topic starter
 

Olá pessoa,

preciso alterar a cor de diversas formas baseado no número digitado em determinadas células

ex. valor em "B3" altera a cor da forma 'Semi 1", valor em "C3" altera a cor da forma 'Semi 2" e assim por diante.

o problema é que tenho 132 formas para alterar a cor e cada célula tem 5 opções de cor, quando chego na penúltima coluna (lá pela forma de numero 100) o excel fala que o procedimento é muito grande e não consigo concluir todas as condições, tem alguma forma de resolver isso? acredito que o código que estou usando não está bem feito, talvez possa ser resumido

Public Sub Worksheet_Change(ByVal Target As Range)
     
    If Not Intersect(Target, Range("B3")) Is Nothing Then
        If IsNumeric(Target.Value) Then
            If Target.Value = 3 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.RGB = RGB(128, 64, 75)
            ElseIf Target.Value = 0 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.SchemeColor = 1
            ElseIf Target.Value = 5 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Target.Value = 9 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.RGB = RGB(100, 150, 81)
            Else
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.SchemeColor = 0
            End If
        End If
    End If
 
Postado : 27/07/2016 1:21 pm
engeel2014
 engeel2014
(@engeel2014)
Posts: 207
Estimable Member
 

amigão, você repetiu o código muitas vezes, ficou enorme. Talvez se fizer assim, fique melhor. teste aí:

Private Sub Worksheet_SelectionChange(ByVal target As Range)
    Dim KeyCells As Range

    Set KeyCells = Range("B3:O13")
     
    If Not Application.Intersect(KeyCells, Range(target.Address)) Is Nothing Then
     
        If IsNumeric(target.Value) Then
            If target.Value = 3 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.RGB = RGB(128, 64, 75)
            ElseIf target.Value = 0 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.SchemeColor = 1
            ElseIf target.Value = 5 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.RGB = RGB(255, 255, 0)
            ElseIf target.Value = 9 Then
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.RGB = RGB(100, 150, 81)
            Else
                ActiveSheet.Shapes("Semi 1").Fill.ForeColor.SchemeColor = 0
            End If
        End If
    End If
           
End Sub

Lucélio Ferreira dos Santos
Eng. Eletricista
CREA: DF-7165/TD
[email protected]

 
Postado : 27/07/2016 7:54 pm
edilsonfl
 edilsonfl
(@edilsonfl)
Posts: 227
Estimable Member
 

olá nepow,

na minha opinião para usar VBA no seu projeto seria melhor mudar o nome das figuras para que ao selecionar determinada célula já fosse associado o nome da imagem, por exemplo semi_3_3 (referente a lin 3 col 3), Semi_4_3 (referente a lin 4,col 3) etc.
Na sua planilha também constam muitas figuras sobrepostas.

Não fiz modificações no seu código VBA,
na planilha que segue em anexo sugiro usar formatação condicional,
verifique se é apropriado para você.

Teste 2 - Edilson .zip

Quando ajuda for útil dê um clique na mãozinha, isso atribui ponto ao colaborador.

 
Postado : 28/07/2016 2:54 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico