Notifications
Clear all

unir duas macros

2 Posts
2 Usuários
0 Reactions
743 Visualizações
(@brandaogcb)
Posts: 0
New Member
Topic starter
 

Boa tarde pessoal, tenho um problema para resolver. Preciso unir duas macros Private Sub worksheet_change.

1) Como estou usando o excel 2003, preciso de mais formatações condicionais, por isso consegui (online) um código que permite as alterações de cor conforme as instruções abaixo:

Private Sub Worksheet_Change(ByVal Target As Range)

Set MyPlage = Range("A1:Z150")
For Each cell In MyPlage

If cell.Value = "INDISP." Then
cell.Interior.ColorIndex = 22
cell.Interior.Pattern = xlPatternUp
cell.Font.Bold = True
cell.Font.color = vbWhite
End If

If cell.Value = "ALE TEMPO" Then
cell.Interior.ColorIndex = 40
cell.Font.Bold = True
cell.Interior.Pattern = xlPatternSolid
cell.Font.color = vbBlack
End If

If cell.Value = "ALE POSTOS" Then
cell.Interior.ColorIndex = 43
cell.Font.Bold = True
cell.Interior.Pattern = xlPatternSolid
cell.Font.color = vbBlack
End If

If cell.Value = "ALE VOO" Then
cell.Interior.ColorIndex = 33
cell.Font.Bold = True
cell.Interior.Pattern = xlPatternSolid
cell.Font.color = vbBlack
End If

If cell.Value = "RAD" Then
cell.Interior.ColorIndex = 27
cell.Font.Bold = True
cell.Interior.Pattern = xlPatternSolid
cell.Font.color = vbBlack
End If

If cell.Value = "ITG" Then
cell.Interior.ColorIndex = 27
cell.Font.Bold = True
cell.Interior.Pattern = xlPatternSolid
cell.Font.color = vbBlack
End If

If cell.Value = "MRO" Then
cell.Interior.ColorIndex = 46
cell.Font.Bold = True
cell.Interior.Pattern = xlPatternSolid
cell.Font.color = vbBlack
End If

If cell.Value = "PSO" Then
cell.Interior.ColorIndex = 46
cell.Font.Bold = True
cell.Interior.Pattern = xlPatternSolid
cell.Font.color = vbBlack
End If

If cell.Value = "TAV" Then
cell.Interior.ColorIndex = 3
cell.Font.Bold = True
cell.Font.color = vbWhite
cell.Interior.Pattern = xlPatternSolid
End If

If cell.Value = "TDE" Then
cell.Interior.ColorIndex = 3
cell.Font.Bold = True
cell.Font.color = vbWhite
cell.Interior.Pattern = xlPatternSolid
End If

Next
End Sub

2) Também preciso que uma determinada célula pisque de acordo com o valor de outra (no caso <> "0").

Option Explicit
Public CellCheck As Boolean
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
     
    If Range("A2") <> "0" And CellCheck = False Then
        Call StartBlink
        CellCheck = True
    ElseIf Range("A2") = "0" And CellCheck = True Then
        Call StopBlink
        CellCheck = False
    End If
     
End Sub

---

Option Explicit
Public RunWhen As Double
 
Sub StartBlink()
    If Range("A1").Interior.ColorIndex = 3 Then
        Range("A1").Interior.ColorIndex = 6
    Else
        Range("A1").Interior.ColorIndex = 3
    End If
    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, "StartBlink", , True
End Sub
 
Sub StopBlink()
    Range("A1").Interior.ColorIndex = 2
    Application.OnTime RunWhen, "StartBlink", , False
End Sub

Alguém poderia me ajudar a unir esses dois códigos na mesma planilha.

Elas funcionam perfeitamente quando separadas.

 
Postado : 27/10/2015 1:52 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Desmembrado do tópico:

viewtopic.php?f=10&t=9252&p=90465#p90465

Sempre crie um novo tópico para as tuas dúvidas, não aproveite tópico dos outros.

Patropi - Moderador

 
Postado : 27/10/2015 4:01 pm