Saberexcel - site das macros

Essas macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), seleciona a próxima linha célula colorida, com interior colorido, irá selecionando na coluna desejada até atingir o limite da última linha, neste ponto voce poderá retroceder a seleção de células coloridas,
pois, selecionará até o ponto inicial ou final e emitirá uma mensagem, alertando sobre o limite maximo atingido.
Observe que o macro também insere cores na fonte.

Option Explicit

Sub Procurar_cores_abaixo()
Dim vLinha As Long
vLinha = Range("A65536").End(xlUp).Row
If ActiveCell.Row >= vLinha Then
MsgBox "Atingiu última linha.", vbInformation, "Saberexcel - site das macros"
Exit Sub
End If
Do
Selection.Offset(1, 0).Select
ActiveCell.Offset(1, 0).Font.ColorIndex = 5
Loop Until (ActiveCell.Interior.ColorIndex <> xlColorIndexNone And ActiveCell.Interior.ColorIndex <> 1) Or ActiveCell.Row = vLinha
End Sub

Sub Procurar_cores_acima()
Dim vLinha As Long
vLinha = 2
If ActiveCell.Row <= vLinha Then
MsgBox "Atingiu a primeira linha.", vbInformation, "Saberexcel - site das macros"
Exit Sub
End If

Do
Selection.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).Font.ColorIndex = 9
Loop Until (ActiveCell.Interior.ColorIndex <> xlColorIndexNone And ActiveCell.Interior.ColorIndex <> 1) Or ActiveCell.Row = vLinha
End Sub


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application) , sozinho, praticando com os produtos didáticos Saberexcel

Saberexcel - o site de quem precisa aprender Macros Microsoft Excel VBA.

Essa macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere cores aleatórias em todas as palavras contidas em determinadas células,
neste caso específico insere em uma célula(H3) uma condição IF, para que voce possa testar e entender melhor o exemplo, por exemplo se o valor da célula [H3] for igual a "cores", o macro irá inserir cores no interior da célula e também cores aleatórias em cada palavra da célula a cada execução da macro, caso escolha o valor da célula "branco", então não vai inserir cores no interior da célula, somente cores aleatórias em todas as palavras contidas na frase na célula A1. Por exemplo a frase ficaria assim, com cores aleatórias a cada execução do macro.

Espero que gostem do exemplo, Fique com Deus, Expedito Marcondes.
Esta planiha faz parte do MODULO COMO FAZER - Programação Microsoft Excel VBA_V
( há alguns exemplos dos módulos COMO FAZER Programação MS Excel VBA, como demonstração) - São muito bons.


Public Sub cores_aleatorias_frase()
Dim vRange As Range
Dim vCorInterior As Integer
Dim sbArray
Dim i As Long, vTemp As Long

'Todas as palavras de uma célula com a cor da fonte aleatória

Set vRange = Saber1.Range("A1")

If vRange.Value = "" Then
MsgBox "Não há nenhum texto na célula", vbInformation, "Saberexcel - site das macros"
Exit Sub
End If

sbArray = Split(vRange.Value)
Randomize
'[A1].Select
For i = 0 To UBound(sbArray)
vCorInterior = Int((56 * Rnd) + 1)
vRange.Characters(Start:=vTemp + i, Length:=Len(vRange)).Font.ColorIndex = vCorInterior

'(condição IF) somente para ilustrar o teste mudar a cor de fundo do intervalo de células
If [H3].Value = "cores" Then
[A1:J1].Interior.ColorIndex = vCorInterior
[H5].Value = "H3 = palavra 'cores' Mudará as cores da fonte de cada letra da frase e interior da célula"
[H5].Font.ColorIndex = 11
Else
[A1:J1].Interior.ColorIndex = xlNone
[H5].Value = "H3 = palavra 'branco' Mudará apenas as cores da fonte de cada letra da frase"
[H5].Font.ColorIndex = 7
End If

vTemp = vTemp + Len(sbArray(i))

Next i

Set vRange = Nothing
Erase sbArray
End Sub

Essas macros abaixo são apenas auxiliar para o teste, para facilitar, mas uso muito em aplicações em programas acho de boa utilidade.
Sub visualizar_macros_vbe()
Dim Resposta As String

Resposta = MsgBox("Deseja visualizar as macros no módulo VBE?", vbYesNo, "Saberexcel - o site das macros")
If Resposta = 6 Then ' 6 é igual a vbyes
Application.Goto reference:="cores_aleatorias_frase"
Else
Saber1.Shapes("sb").Visible = True
End If
End Sub

Sub oc()
Saber1.Shapes("sb").Visible = False
End Sub





Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

Publicidade
Compre com segurança, garantia e ótimos preços

Saberexcel - o site de quem precisa aprender Macros Microsoft Excel VBA.

Este macro do Aplicativo Micrososoft Excel VBA(Visual Basic Application), insere cores no interior e fonte das células na coluna (O), dependendo da letra nas células, observe que estamos usando uma instrução Case para realização do teste, No macro foram usados somente (4) quatro letras, A, B, C e D, para cada letra inserida, foi estipulado uma cor de fundo da célula e também uma fonte diferente. Veja também que usei o mesmo Loop For next, usado na instrução case para localizar as células na coluna desejada, para retirar a formatação, isso para ajudar na realização do teste, porque senão a cada execução do macro voce teria que apagar os formatos de células.

Sub Colorir_fonte_interior_letra()
For N = 1 To Range("O65536").End(xlUp).Row

Select Case Range("O" & N)
Case "A"
Range("O" & N).Interior.ColorIndex = 3
Range("O" & N).Font.ColorIndex = 1

Case "B"
Range("O" & N).Interior.ColorIndex = 4
Range("O" & N).Font.ColorIndex = 2

Case "C"
Range("O" & N).Interior.ColorIndex = 5
Range("O" & N).Font.ColorIndex = 3

Case "D"
Range("O" & N).Interior.ColorIndex = 7
Range("O" & N).Font.ColorIndex = 12

Case Else
Range("O" & N).Interior.ColorIndex = 6
Range("O" & N).Font.ColorIndex = 4
End Select

Next N

End Sub

Para ajudá-los com a criatividade com macros vamos usar o mesmo Loop acima para mudar a formatação, para nos auxliar com o teste.
observe que o loop verificará todos as células com cores do interior das estiverem com cores diferentes de 02(branco) , insere a cor branco no interior das células, aqui poderiamos usar um clearformats em todas as células usadas , seria também outra alternativa usando o Loop For next.

Sub limpar_formatacao_teste()
For N = 1 To Range("O65536").End(xlUp).Row
If Range("O" & N).Interior.ColorIndex <> 1 Then
Range("O" & N).Interior.ColorIndex = 1
End If
Next N
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel




Publicidade
Compre com segurança, garantia e ótimos preços

Saberexcel - o site de quem precisa aprender Macros Microsoft Excel VBA

Esses macros e procedimentos do Aplicativo Microsoft Excel VBA, inserem cores personalizadas, em intervalos de células
determinados na folha de planilha dependendo da condição, neste caso optamos pela palavra' OK' (Maiúsculo)
'................................................'
os macros abaixo inseridos no procedimento com o EventoChange na folha de planilha, ocorre ao digitar em determinado range na folha de planilha.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sb As Range
For Each sb In ActiveSheet.Range("A1:J20")
If sb = "" Then 'poderia usar essa condição, se celula estiver em branco, retira formatação(0)
'If sb <> "OK" Then
sb.Interior.ColorIndex = 0
ElseIf sb = "OK" Then
sb.Interior.ColorIndex = 6
End If
Next
End Sub
'................................................'

Sub FC_formatacao_condicional_celulas(Target)
Dim sb As Range
'If sb = "" then 'poderia usar essa condição, se celula estiver em branco, retira formatação(0)
For Each sb In ActiveSheet.Range("A1:J20")
If sb = "" Then
sb.Interior.ColorIndex = 0
sb.Font.ColorIndex = 0
ElseIf sb = "OK" Then
sb.Interior.ColorIndex = 20
sb.Font.ColorIndex = 9
End If
Next
End Sub

Sub FC_Cores_rotina()
Call FC_formatacao_condicional_celulas("A1:J20")
End Sub

Sub Mostrar_cores_numeros()
Saber2.Select
limpar_teste
For c = 1 To 56
Cells(c, 1).Value = c 'número das repectivas cores na coluna(1)
Cells(c, 2).Interior.ColorIndex = c 'cores com seus respectivos números.
Next c
Cells.Font.Size = 8
End Sub

Sub Mostrar_cores_numeros_I()
Saber2.Select
limpar_teste
For i = 1 To 56
For Each c In Range("A1:A56").Cells
c.Interior.ColorIndex = i
c.Offset(0, 1).Value = "COR VBA CÓDIGO: " & i
i = i + 1
Next
Next
Cells.Font.Size = 8
End Sub

Sub limpar_teste()
If ActiveSheet.Name = "Auxiliar" Then
Saber2.[A1:C100].Clear
Cells.Font.Size = 8
Exit Sub
Else
Saber2.[A1:C100].Clear
MsgBox ("Fomatação na planilha Auxiliar deletadas com sucesso!"), vbInformation, "Saberexcel - o site dos Macros" 'caso tiver em outra planilha
Cells.Font.Size = 8
End If
End Sub



Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

Publicidade
Compre com segurança, garantia e ótimos preços

Saberexcel - o site de quem precisa Aprender Macros Microsoft Excel VBA

Esse procedimento do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere determinada cor em determinada coluna ao dar um duplo clique na célula, insere a letra 'x' com cor determinante, ao clicar novamente na célula formatada, que poderá ser um status, limpa novamente a cor e o 'x' inserido.

Private Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)

If Target.Column = 2 Then
If Cells(Target.Row, 2).Interior.ColorIndex <> 3 Then
Cells(Target.Row, 2).Interior.ColorIndex = 3
Cells(Target.Row, 2).Value = "x"
Else
Cells(Target.Row, 2).Interior.ColorIndex = 2
Cells(Target.Row, 2).Value = ""
End If
End If

If Target.Column = 3 Then
If Cells(Target.Row, 3).Interior.ColorIndex <> 6 Then
Cells(Target.Row, 3).Interior.ColorIndex = 6
Cells(Target.Row, 3).Value = "x"
Else
Cells(Target.Row, 3).Interior.ColorIndex = 2
Cells(Target.Row, 3).Value = ""
End If
End If

If Target.Column = 4 Then
If Cells(Target.Row, 4).Interior.ColorIndex <> 4 Then
Cells(Target.Row, 4).Interior.ColorIndex = 4
Cells(Target.Row, 4).Value = "x"
Else
Cells(Target.Row, 4).Interior.ColorIndex = 2
Cells(Target.Row, 4).Value = ""
End If
End If

End Sub




Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

Publicidade
Compre com segurança, garantia e ótimos preços