(Resolvido) VBA Excel - Cor sim cor não

[G.Anjos]

Bom dia pessoal do Scriptbrasil.

Antes de criar o tópico pesquisei muito, inclusive aqui, mas não encontrei uma solução que fosse adequada a minha necessidade ou que eu entedesse, explico:

Necessidade;

Aplicar uma tonalidade de cor alternando entre as linhas a partir da celula A5.

Observações;

Os dados são importados de uma base SQL da rede, logo não é possível determinar qual será o intervalo para aplicar as cores.

Soluções que encontrei;

Utilizar MSFlexgrid

Utilizar Condição a partir de teste em celulas com valor NotEmpty

|| Copiar o conteudo de uma macro(macro para inserir cor) para criar o Modulo

- E mais algumas que não me recordo agora.

A questão é que com meu nível de conhecimento (básico, utilizo a ferramenta junto com Macros) algumas explicações como a do MsFlexgrid acabam dependendo de detahes que ainda desconheço, e com o chefe me cobrando hora após hora fica dificil.

Gostaria de alguma orientação no assunto, acompanhado de uma solução de fácil entendimento ou com uma explicação.

Agradeço a todos a colaboração.

[raphael_suporte]

você preenche os campos através de um recordset, dentro do loop você poderá colocar uma variavel de controle... e colocar um if para validar essa variável, o if condicional ficaria mais ou menos assim

If (i  = 0) Then
    ActiveCell.Interior.ColorIndex = 36
    i = 1
 Else
    ActiveCell.Interior.ColorIndex = 40
    i = 0
 End If

quando declarar seu "i" coloque o valor 0, isso faz com que fique um efeito "tigrado", qualquer dúvida poste seu código aqui e te explico melhor.

esse código deve ficar dentro do loop do recordset, após o comando de "setar" a célula que será preenchida.

[G.Anjos]

você preenche os campos através de um recordset, dentro do loop você poderá colocar uma variavel de controle... e colocar um if para validar essa variável, o if condicional ficaria mais ou menos assim

If (i  = 0) Then
    ActiveCell.Interior.ColorIndex = 36
    i = 1
 Else
    ActiveCell.Interior.ColorIndex = 40
    i = 0
 End If

quando declarar seu "i" coloque o valor 0, isso faz com que fique um efeito "tigrado", qualquer dúvida poste seu código aqui e te explico melhor. esse código deve ficar dentro do loop do recordset, após o comando de "setar" a célula que será preenchida.

Boa tarde Raphael, obrigado pela resposta tão rapida. Este é meu Modulo 2, modulo que gostaria que ficasse a condição. A partir daqui poderia continuar a exemplificação?! VLw

Public Function ConectarSQL() As Boolean
Dim timeout As Integer


On Error GoTo trataErro

    timeout = 0
    Set connSQLSERVER = New ADODB.Connection
    
    strDataSoure = "STVSAWN1441"
    strDataBase = "UKPRD1418"
    strUser = "CEDATABASE"
    strPWD = "Dsa98765"

    'Aqui é montada a string de conexão
    strConexao = "Provider=SQLOLEDB.1;SERVER=" & strDataSoure
    strConexao = strConexao & ";DATABASE=" & strDataBase
    strConexao = strConexao & ";UID=" & strUser
    strConexao = strConexao & ";PWD=" & strPWD

    'Criando um objeto de conexão com a base de dados e executa a Query
    connSQLSERVER.Open strConexao
    
    ' Cria o objeto Recordset.
    Dim rsstrConexao As ADODB.Recordset
    Set rsstrConexao = New ADODB.Recordset

    With rsstrConexao
      ' Associa a conexão.
      .ActiveConnection = strConexao
      ' Extrai os dados.
      .Open "SELECT BEL_DIVISAO.NomeDivisao, BEL_REPRESENTANTE.Territorio, BEL_REPRESENTANTE.NomeRepresentante, BEL_REPRESENTANTE.MudId, BEL_REPRESENTANTE.Logradouro, BEL_REPRESENTANTE.Complemento, BEL_REPRESENTANTE.Cidade, BEL_REPRESENTANTE.UF, BEL_REPRESENTANTE.Telefone, BEL_REPRESENTANTE.Celular, BEL_REPRESENTANTE.Email FROM UKPRD1418.dbo.BEL_DIVISAO BEL_DIVISAO, UKPRD1418.dbo.BEL_REPRESENTANTE BEL_REPRESENTANTE WHERE BEL_DIVISAO.IdDivisao = BEL_REPRESENTANTE.IdDivisao"
      ' Coloca os dados na planilha.
      
        Range("A5").Select
        ActiveCell.FormulaR1C1 = "Divisão"
        Range("B5").Select
        ActiveCell.FormulaR1C1 = "Território"
        Range("C5").Select
        ActiveCell.FormulaR1C1 = "Representante"
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "MUDID"
        Range("E5").Select
        ActiveCell.FormulaR1C1 = "Logradouro"
        Range("F5").Select
        ActiveCell.FormulaR1C1 = "Complemento"
        Range("G5").Select
        ActiveCell.FormulaR1C1 = "Cidade"
        Range("H5").Select
        ActiveCell.FormulaR1C1 = "UF"
        Range("I5").Select
        ActiveCell.FormulaR1C1 = "Telefone"
        Range("J5").Select
        ActiveCell.FormulaR1C1 = "Celular"
        Range("L5").Select
        ActiveCell.FormulaR1C1 = "E-mail"
        Range("K5").Select
      
        Range("A6").CopyFromRecordset rsstrConexao

    End With

    ' Fecha conexão
    'ConectarSQL = True
    Exit Function
    
trataErro:
    'timeout
    If Err.Number = -2147467259 And timeout < 5 Then
        timeout = timeout + 1
       Resume
   Else
        MsgBox Err.Number & " - " & Err.Description
        Debug.Print Err.Number
        
        ConectarSQL = False
        Resume Next
    End If

[raphael_suporte]

G.Anjos, você pode fazer de duas formas:

1- após copias seus dados você faz um loop para validar e colorir seus campos

2- ao invés de copiar você coloca um loop.

acho que o primeiro modo é o mais fácil por isso estou adaptando seu código para este modo, para alterar a cor basta mudar o valor do index.

Range("A6").CopyFromRecordset rsstrConexao

'inclua o código nesta parte:

'Colocar celulas com colocação alternadas
Do While teste
 ActiveSheet.Range("A" & i & ":c" & i).Select
 If ActiveCell = "" Then
  teste = False
 Else
    If (i Mod 2) = 0 Then
            ActiveCell.Range("A" & i & ":c" & i).Interior.ColorIndex = 14
    Else
           ActiveCell.Range("A" & i & ":c" & i).Interior.ColorIndex = 15
    End If
    i = i + 1
 End If

Loop



End With

    ' Fecha conexão
    'ConectarSQL = True
    Exit Function


'Essa parte na declaração de variaveis no inicio do código.
Dim i As Integer
Dim teste As Boolean

teste = True
i = 6

[G.Anjos]

Excelente Raphael.

Com sua dica e mais umas leituras consegui aprimorar mais ainda o resultado final!!!

Muito obrigado. :D