none
Escala de cores? RRS feed

  • Pergunta

  • Gostaria de saber como montar uma escala de cores com todas as combinações de cores utilizando RGB.

    Todas as combinações possíveis com (255, 255, 255)

    Tenho o código a seguir

    Poderia corrigir?

    Sub teste()
    
    Sheets("Plan1").Cells.ClearContents
    
    lin = 1
    col = 1
    r = 0
    g = 0
    b = 0
    
    While r <= 255
    
    If g > 255 Then
    
    g = 1
    r = r + 1
    
    End If
    
    If b > 255 Then
    
    b = 1
    g = g + 1
    col = col + 4
    lin = 1
    
    End If
    
    
    Sheets("Plan1").Cells(lin, col) = r
    Sheets("Plan1").Cells(lin, col + 1) = g
    Sheets("Plan1").Cells(lin, col + 2) = b
    Sheets("Plan1").Cells(lin, col + 3).Interior.Color = RGB(r, g, b)
    lin = lin + 1
    b = b + 1
    
    Wend
    
    End Sub
    

    O código acima está dando o erro:

    Há muitos formatos diferentes de células.

    sexta-feira, 1 de novembro de 2013 20:55

Respostas

  • Fiz uma escala simplificada, pulando de dez em dez:

    Sub teste()
    
    Sheets("Plan1").Cells.ClearContents
    
    lin = 1
    col = 1
    r = 0
    g = 0
    b = 0
    
    While r <= 255
    
    If g > 255 Then
    
    g = 0
    r = r + 10
    
    End If
    
    If b > 255 Then
    
    b = 0
    g = g + 10
    col = col + 4
    lin = 1
    
    End If
    
    
    Sheets("Plan1").Cells(lin, col) = r
    Sheets("Plan1").Cells(lin, col + 1) = g
    Sheets("Plan1").Cells(lin, col + 2) = b
    Sheets("Plan1").Cells(lin, col + 3).Interior.Color = RGB(r, g, b)
    lin = lin + 1
    b = b + 10
    
    Wend
    
    End Sub
    

    • Marcado como Resposta AndersonFDiniz sábado, 2 de novembro de 2013 02:33
    sábado, 2 de novembro de 2013 01:18

Todas as Respostas

  • Fiz uma escala simplificada, pulando de dez em dez:

    Sub teste()
    
    Sheets("Plan1").Cells.ClearContents
    
    lin = 1
    col = 1
    r = 0
    g = 0
    b = 0
    
    While r <= 255
    
    If g > 255 Then
    
    g = 0
    r = r + 10
    
    End If
    
    If b > 255 Then
    
    b = 0
    g = g + 10
    col = col + 4
    lin = 1
    
    End If
    
    
    Sheets("Plan1").Cells(lin, col) = r
    Sheets("Plan1").Cells(lin, col + 1) = g
    Sheets("Plan1").Cells(lin, col + 2) = b
    Sheets("Plan1").Cells(lin, col + 3).Interior.Color = RGB(r, g, b)
    lin = lin + 1
    b = b + 10
    
    Wend
    
    End Sub
    

    • Marcado como Resposta AndersonFDiniz sábado, 2 de novembro de 2013 02:33
    sábado, 2 de novembro de 2013 01:18
  • Sub fnc()
      Const cintPulo As Integer = 10
      
      Dim intR As Integer
      Dim intG As Integer
      Dim intB As Integer
      Dim lngRow As Long
      
      For intR = 1 To 255 Step cintPulo
        For intG = 1 To 255 Step cintPulo
          For intB = 1 To 255 Step cintPulo
            lngRow = lngRow + 1
            Cells(lngRow, "A").Interior.Color = RGB(intR, intG, intB)
          Next intB
        Next intG
      Next intR
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sábado, 2 de novembro de 2013 20:35
    Moderador