Como poner borde de otro color

Tengo el código que me pone los colores que deseo, pero quiero que cuando se seleccione una opción cambie el borde; es decir el contenido azul y el borde rojo; pero no me da

Private Sub RellenaColor()
Dim ctl As Control
Dim rs As DAO.Recordset
Dim i As Integer
Dim mColor As String
For Each ctl In Me.Controls
If ctl.ControlType = acLabel Then
If IsNumeric(Left(ctl.Name, 2)) Then
ctl.BackColor = 16777215
ElseIf Left(ctl.Name, 3) = "Exo" Then
ctl.Visible = False
ElseIf Left(ctl.Name, 4) = "ExoI" Then
ctl.Visible = False
End If
End If
Next ctl
If Me.cboPaciente = "" Or IsNull(Me.cboFechaVisita) Then Exit Sub
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblOdontograma WHERE Paciente = '" & Me.cboPaciente & _
"' AND FechaVisita = #" & Format(Me.cboFechaVisita, "mm/dd/yyyy") & "#")
If Not rs.EOF Then
rs.MoveLast
rs.MoveFirst
For i = 1 To rs.RecordCount
Select Case rs!afeccion
Case 1 'Caries
mColor = 255
Case 2 'Amalgama
mColor = 16711680
Case 3 'Amalgama Defectuosa
mColor = 25512
Case 4 'Resina
mColor = 65280
Case 5 'Resina Defectuosa
mColor = 255132123

Aquí quiero que el contenido sea por ejemplo azul y el borde rojo, pero no he podido hacerlo

Case 6 'Exodoncia Indicada
mColor = "Exo"
Case 7 'Exodoncia Realizada
mColor = "ExoI"
Case 8 'Endodoncia por Realizar
mColor = 2366
Case 9 'Endodoncia Realizada
mColor = 255
Case 10 'Endodoncia Defectuosa
mColor = 16711680
Case 11 'Diente sin Erupcionar
mColor = 65280
Case 12 'Diente Ausente
mColor = 2566
Case 13 'Sellante Indicado
mColor = 255
Case 14 'Sellante Realizado
mColor = 16711680
Case 15 'Corona en Buen Estado
mColor = 65280
Case 16 'Corona en Mal Estado
mColor = 12222
End Select
If mColor = "Exo" Then
Me.Controls("exo" & rs!pieza).Visible = True
ElseIf mColor = "ExoI" Then
Me.Controls("exoi" & rs!pieza).Visible = True
Else
Me.Controls(rs!pieza & rs!cara).BackColor = mColor
End If
rs.MoveNext
Next i
End If
rs.Close
Set rs = Nothing
End Sub
Private Sub cboFechaVisita_AfterUpdate()
RellenaColor
End Sub
Private Sub cboPaciente_AfterUpdate()
Me.cboFechaVisita.Requery
Me.cboFechaVisita = Me.cboFechaVisita.ItemData(0)
RellenaColor
End Sub
Private Sub Form_Load()
RellenaColor
Dim larp As String
Dim ctl As Control
For Each ctl In Me.Controls
If ctl.ControlType = acLabel And IsNumeric(Left(ctl.Name, 2)) Then
larp = "=barra('" & ctl.Name & "','Colores', 'Caries', 1, 'Amalgama', 2, 'Amalgama Defectuosa', 3, 'Resina', 4,'Resina Defectuosa', 5, 'Exodoncia Indicada', 6, 'Exodoncia Realizada', 7, 'Endodoncia por Realizar', 8,'Endodoncia Realizada', 9, 'Endodoncia Defectuosa', 10, 'Diente sin Erupcionar', 11, 'Diente Ausente', 12,'Sellante Indicado', 13)"
ctl.OnClick = larp
End If
Next ctl
End Sub
Function barra(mieti As String, nombreBarra As String, ParamArray valores() As Variant)
Dim cbar As Office.CommandBar
Dim i As Integer
Dim ctl As CommandBarControl
If (UBound(valores()) + 1) Mod 2 <> 0 Then
MsgBox "Número de parámetros incorrectos pasados a la función 'barra'" & Chr(13) & _
"Debe introducir el literal y el valor por parejas" & Chr(13) & _
"Revise la sintaxis de la funcion barra en el modulo BarraEmergente", vbInformation + vbOKOnly, "ERROR DE SINTAXIS"
Exit Function
End If
For Each cbar In CommandBars
If cbar.Name = nombreBarra Then
cbar.Delete
Exit For
End If
Next cbar
Set cbar = CommandBars.Add(Name:=nombreBarra, Position:=msoBarPopup, Temporary:=True)
cbar.Protection = msoBarNoCustomize
For i = 0 To UBound(valores())
Set ctl = cbar.Controls.Add(Type:=1)
ctl.Caption = valores(i)
i = i + 1
ctl.OnAction = "= Asignavalor('" & mieti & "', '" & valores(i) & "')"
Next i
Set ctl = Nothing
Set cbar = Nothing
CommandBars(nombreBarra).ShowPopup
End Function
Function AsignaValor(Etiqueta As String, Valor As String)
Dim rs As DAO.Recordset
If IsNull(Me.cboPaciente) Or Me.cboPaciente = "" Then
MsgBox "Debe seleccionar un Paciente y Fecha de Visita", vbInformation + vbOKOnly, "ATENCION"
Exit Function
End If
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblOdontograma WHERE Paciente= '" & _
Me.cboPaciente & "' AND FechaVisita= #" & _
Format(Me.cboFechaVisita, "mm/dd/yyyy") & "# AND " & _
"Pieza= " & Left(Etiqueta, 2) & " AND Cara = '" & _
Right(Etiqueta, 1) & "'")
If Not rs.EOF Then
rs.Edit
rs!afeccion = Valor
rs.Update
Else
rs.AddNew
rs!Paciente = Me.cboPaciente
rs!fechavisita = Me.cboFechaVisita
rs!pieza = Left(Etiqueta, 2)
rs!cara = Right(Etiqueta, 1)
rs!afeccion = Valor
rs!IdConsulta = IdConsulta
rs!Documento = Documento
rs!Profesional = Profesional
rs.Update
End If
rs.Close
Set rs = Nothing
RellenaColor
End Function