none
Mudar BACKCOLOR de Listboxes conforme condições RRS feed

  • Pergunta

  • Bom dia Pessoal,

    Com a rotina abaixo, eu verifico verifico se o valor de algumas LABEL (LABEL 1 até 37) são igual aos valores contidos em uma planilha.

    Até ai a rotina esta cumprindo corretamente seu papel, porém, eu preciso fazer uma outra validação, verificando quando o valor da LABEL for menor que o valor contido em LISTBOX. E quando esse valor for menor colorir o próximo LISTBOX.

    Da forma como a rotina esta, ela verifica apenas o próximo LISTBOX, porém eu preciso que ela percorra os outros. Acredito que seja necessário criar um outro laço, mas em minhas tentativas acabei piorando a rotina, e então achei melhor solicitar ajuda.

    No exemplo abaixo, o valor de 07:00 e de 07:30 é menor que o valor da planilha, então os listboxes também deveriam ser coloridos de verde.

    Sub teste()
    
    Dim lbl As MSForms.Label
    Dim lbl2 As MSForms.Label
    Dim lbx As MSForms.ListBox
    Dim lbx2 As MSForms.ListBox
    Dim k As Integer
    Dim k2 As Integer
    Dim j As Integer
    Dim j2 As Integer
    
    Dim Plan As Worksheet
    Dim i As Double
    Dim ii As Long
    Dim lItem As Double
    i = 2
    a = 0
    
    Set Plan = Sheets("agenda")
    Sheets("agenda").Activate
                
        
        For ii = 2 To Plan.Range("A65536").End(xlUp).Row
        
            For j = 1 To 37
            For k = 1 To 37
                        
            Set lbl = Me.Controls("Label" & k)
            Set lbl2 = Me.Controls("Label" & k + 1)
            Set lbx = Me.Controls("ListBox" & j)
            Set lbx2 = Me.Controls("ListBox" & j + 1)
       
                If Plan.Range("A" & ii).Value = lbl And Format(Range("B" & ii).Value) = LBAT1 Then
              
                    lbx.AddItem , Listindex
                    lbx.List(a, 0) = Range("E" & ii).Value
                    lbx.List(a, 1) = Range("R" & ii).Value
                    lbx.List(a, 2) = Range("H" & ii).Value
                    lbx.List(a, 3) = Range("I" & ii).Value
              
                        If lbx.List(a, 1) = "M" Then
                            lbx.BackColor = &HFFFF&
                        ElseIf lbx.List(a, 1) = "A" Then
                            lbx.BackColor = &HFF8080
                        ElseIf lbx.List(a, 1) = "PG" Then
                            lbx.BackColor = &HFF00&
                        ElseIf lbx.List(a, 1) = "C" Then
                            lbx.BackColor = &HFF&
                        End If
                        
                        '-------------------------------------------------------
                        '  colorir proximo list
                     
                                   
                                    If lbl2.Caption < lbx.List(a, 3) Then
           
                                        If lbx.List(a, 1) = "M" Then
                                            lbx2.AddItem , Listindex
                                            lbx2.List(a, 0) = Range("E" & ii).Value
                                            lbx2.List(a, 1) = Range("R" & ii).Value
                                            lbx2.List(a, 2) = Range("H" & ii).Value
                                            lbx2.List(a, 3) = Range("I" & ii).Value
                                            lbx2.BackColor = &HFFFF&
                                        ElseIf lbx.List(a, 1) = "A" Then
                                            lbx2.AddItem , Listindex
                                            lbx2.List(a, 0) = Range("E" & ii).Value
                                            lbx2.List(a, 1) = Range("R" & ii).Value
                                            lbx2.List(a, 2) = Range("H" & ii).Value
                                            lbx2.List(a, 3) = Range("I" & ii).Value
                                            lbx2.BackColor = &HFF8080
                                        ElseIf lbx.List(a, 1) = "PG" Then
                                            lbx2.AddItem , Listindex
                                            lbx2.List(a, 0) = Range("E" & ii).Value
                                            lbx2.List(a, 1) = Range("R" & ii).Value
                                            lbx2.List(a, 2) = Range("H" & ii).Value
                                            lbx2.List(a, 3) = Range("I" & ii).Value
                                            lbx2.BackColor = &HFF00&
                                        ElseIf lbx.List(a, 1) = "C" Then
                                            lbx2.AddItem , Listindex
                                            lbx2.List(a, 0) = Range("E" & ii).Value
                                            lbx2.List(a, 1) = Range("R" & ii).Value
                                            lbx2.List(a, 2) = Range("H" & ii).Value
                                            lbx2.List(a, 3) = Range("I" & ii).Value
                                            lbx2.BackColor = &HFF&
                                        End If
                                        
                                     
                                    End If
                                 
                              
                                
                      ' termina colorir
                      '-----------------------------------------------
                              
                    ii = ii + 1
                    j = j + 1
                    k = 1
                 End If
                    
                    j = k + 1
                Next k
                 
             Next j
        
        Next ii
        
    
    End Sub

    Não sei se apenas com as rotinas é possível analisar. Caso seja necessário coloco um exemplo.


    Guilherme

    sexta-feira, 29 de julho de 2016 13:57

Todas as Respostas