Elegir 1 color de una lista y agregarle una cifra

Hola a todos! Mi problema es el siguiente: Necesito que un cuadro sea lo más visual posible, consta de todos los días de la semana en las columnas, y en las filas los lugares visitados. Cada día necesito saber que tarea se realizó en cada lugar y cuantos operarios se encargaron de ella. Como son muchos lugares (filas) no es agil todas la veces formatear con color cada celda, sería mucho más fácil tomarlo de una lista con colores preseleccionados, y no habría posibilidad de colocar gamas distintas. Probé con formato condicional en VB, pero no puedo colocar la cantidad de operarios!! Esto es posible?, desde ya muchísimas gracias porque aún cuando esta es mi primera pregunta ya me han ayudado muchas veces con las respuestas dadas a otras personas! Excelente!!  Ah me olvidaba, trabajo con excel 2007. Saludos. Silvia
{"lat":-37.7185903255881,"lng":-59.0625}

1 Respuesta

Respuesta
1
Puedo ayudarte, pero necesito que me expliques bien cómo está organizada tu tabla, porque hay confusión en lo que dices. Si puedes, sube un archivo de ejemplo a http://www.zshare.net/ y me envías el link.
Perfecto, te mando mi archivo!
Acá te paso el link: http://www.zshare.net/download/85547124096e24d5/
De nuevo Gracias!
Esta es tu respuesta y lo que necesitas:
Crear una hoja en tu libro que se llame "Tareas", en la columna A (iniciando en A1) colocas la lista de tareas y cada celda con su respectivo color (esta hoja "Tareas" la puedes ocultar si lo deseas.)
(El análisis de lo que se va a hacer es: Se necesita rescatar en una variable, la celda que fue modificada en cada hoja, con la cantidad de obreros, apra luego abrir un formulario que va a cargar la lista de tareas que se encuentran en la hoja Tareas, y sus respectivos colores, al dar clic en Aceptar en dicho formulario, coloreará la celda que antes habíamos rescatado. El algoritmo evaluará el cambio y si el dato de la celda que cambió es numérico, mostrará el formulario)
Este es el código para cada una de las hojas que se necesite:
Private Sub Worksheet_Activate()
Hoja = ActiveSheet.Name
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Final
If IsNumeric(xXx.value) And xXx <> "" Then
    Celda(1) = xXx.Row
    Celda(2) = xXx.Column
    Hoja = ActiveSheet.Name
    UserForm1.Show
End If
Final:
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set xXx = Target
Hoja = ActiveSheet.Name
End Sub
Este es el código para el formulario (13 OptionButton y 1 CommandButton):
Private Sub CommandButton1_Click()
Sheets(Hoja).Cells(Celda(1), Celda(2)).Interior.Color = Colores(Tarea)
Unload Me
End Sub
Private Sub OptionButton1_Click()
Tarea = 1
End Sub
Private Sub OptionButton2_Click()
Tarea = 2
End Sub
Private Sub OptionButton3_Click()
Tarea = 3
End Sub
Private Sub OptionButton4_Click()
Tarea = 4
End Sub
Private Sub OptionButton5_Click()
Tarea = 5
End Sub
Private Sub OptionButton6_Click()
Tarea = 6
End Sub
Private Sub OptionButton7_Click()
Tarea = 7
End Sub
Private Sub OptionButton8_Click()
Tarea = 8
End Sub
Private Sub OptionButton9_Click()
Tarea = 9
End Sub
Private Sub OptionButton10_Click()
Tarea = 10
End Sub
Private Sub OptionButton11_Click()
Tarea = 11
End Sub
Private Sub OptionButton12_Click()
Tarea = 12
End Sub
Private Sub OptionButton13_Click()
Tarea = 13
End Sub
Private Sub UserForm_Activate()
Dim Asd As String
Dim i As Integer
Dim ColorO As Long
For i = 1 To 13
Asd = Right("000000" & Hex(Sheets("Tareas").Cells(i, 1).Interior.Color), 6)
Colores(i) = Sheets("Tareas").Cells(i, 1).Interior.Color
ColorO = ConvertX(Asd, 16, 10)
Select Case i
Case 1: OptionButton1.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton1.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton1.Visible = True
    End If
Case 2: OptionButton2.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton2.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton2.Visible = True
    End If
Case 3: OptionButton3.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton3.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton3.Visible = True
    End If
Case 4: OptionButton4.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton4.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton4.Visible = True
    End If
Case 5: OptionButton5.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton5.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton5.Visible = True
    End If
Case 6: OptionButton6.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton6.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton6.Visible = True
    End If
Case 7: OptionButton7.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton7.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton7.Visible = True
    End If
Case 8: OptionButton8.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton8Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton8.Visible = True
    End If
Case 9: OptionButton9.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton9.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton9.Visible = True
    End If
Case 10: OptionButton10.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton10.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton10.Visible = True
    End If
Case 11: OptionButton11.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton11.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton11.Visible = True
    MsgBox "asdasdasd"
    End If
Case 12: OptionButton12.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton12.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton12.Visible = True
    End If
Case 13: OptionButton13.BackColor = ColorO
    If Sheets("Tareas").Cells(i, 1) <> "" Then
    OptionButton13.Caption = Sheets("Tareas").Cells(i, 1)
    OptionButton13.Visible = True
    End If
End Select
Next i
End Sub
Y este es el código para Modulo1:
Const NumChars = "0123456789ABCDEF"
Public Colores(13) As Double
Public Celda(2) As Double
Public Tarea As Integer
Public Hoja As String
Public xXx As Range
Public Function ConvertX(ByVal N As String, ByVal fromBase As Integer, ToBase As Integer) As String
Dim Nm As Long, S As String
Nm = ToDec(N, fromBase)
If (Nm = -1) Then
S = ""
Else
S = FromDec(Nm, ToBase)
End If
ConvertX = S
End Function
Public Function ToDec(ByVal S As String, ByVal NumBase As Integer) As Long
Dim R As Long, i As Integer, P As Integer
R = -1
S = UCase(S)
If (NumBase = 2) Or (NumBase = 8) Or (NumBase = 10) Or (NumBase = 16) Then
R = 0
For i = 1 To Len(S)
P = InStr(NumChars, Mid(S, i, 1))
If (P = 0) Or (P > NumBase) Then
R = -1
Exit For
End If
R = R + (P - 1) * (NumBase ^ (Len(S) - i))
Next i
End If
ToDec = R
End Function
Public Function FromDec(ByVal N As Long, ByVal NumBase As Integer) As String
Dim S As String
S = ""
If ((NumBase = 2) Or (NumBase = 8) Or (NumBase = 10) Or (NumBase = 16)) And (N >= 0) Then
Do
S = Mid(NumChars, (N Mod NumBase) + 1, 1) + S
N = Fix(N / NumBase)
Loop Until (N = 0)
End If
FromDec = S
End Function
Te comparto el libro de ejemplo aquí:
http://www.zshare.net/download/85655095d4397ab1/
"El conocimiento le pertenece al mundo"
wow!!!!!!! lo estoy probando!!!!magnifico!!! si no me equivoco en nada al transcribir, por lo que leí, a primera vista es genial! Chicos estoy muy contenta por recibir esta gran ayuda, por el tiempo y la dedicación. Todavía hay gente en el mundo de este calibre!, hace años que navego en Internet (alla por el 95-96, en Italia, cuando todo era re lento y caro, y te cansabas de esperar) y estaba un poco descreída, trato de no dejar mis datos en ningún lado, y dije bue, pruebo... y oh sorpresa! un sitio serio con gente seria y muy capaz. FELICITACIONES A CARANBIS Y A TODO ESPERTOS! Silvia.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas