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"