Modificar codigo userform para que ademas cambie color a una celda.

Cerrado
oaseijas39 Message postés 3 Date d'inscription miércoles, 28 de enero de 2015 Estatus Miembro Última intervención miércoles, 29 de enero de 2020 - 29 ene 2020 a las 19:51
Ante todo gracias por la ayuda que puedas darme...
Es una lastima que no pueda adjuntar la hoja de muestra para ilustrar mejor el problema que tengo.

Bueno... aqui dejo el código del intro del formulario.

Todo funciona muy bien, pero necesito que me coloree de verde le nombre del item que se esté procesando, como se ve en la imagen que coloree de manera manual, que lo haga automaticamente.

de antemano, muchisimas graciaspor su tiempo y generosidad.
Oscar S.



Private Sub cmdIng_Click()

Dim m_row As Integer, bl_continuar As Boolean, I As Integer

If cboMes.Text = Empty Then
Me.cboMes.SetFocus
Beep
Exit Sub
Call Proteger
End If

If cbomiembros.Text = Empty Then
cbomiembros.SetFocus
Beep
Exit Sub
Call Proteger
End If


ActiveSheet.Unprotect

Dim Mes As String, Busco_Mes As Range, Rango_Mes As String, _
Nom As String, Busco_Nom As Range, Rango_Nom As String

Mes = UCase(cboMes.Text)
Nom = cbomiembros.Text


Rango_Mes = "A2:Cu2"
Rango_Nom = "A6:F" & ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row


Set Busco_Mes = ActiveSheet.Range(Rango_Mes).Find(What:=Mes, lookat:=xlPart)
Set Busco_Nom = ActiveSheet.Range(Rango_Nom).Find(What:=Nom, lookat:=xlPart)

Cells(Busco_Nom.Row, Busco_Mes.Column).Select

'comprobamos si hay valores previos
bl_continuar = True
With ActiveCell
For I = 0 To 6
bl_continuar = bl_continuar And IsEmpty(.Offset(0, I))
Next

End With
'Detecta si combobox PS esta vacio
If Me.[CBO_PS] = "" Then 'Cambiar [D11] por la celda que contenga el n° de registro que se quiere reemplazar
MsgBox "Falta indicar Privilegio de servicio" 'Mensaje que se muestra si Textbox PS está vacío y evita continuar
Exit Sub
End If

If bl_continuar Then
ActiveCell.Offset(0, 0).Value = Me.CBO_PS.Value 'Inserta seleccion del CBO:PS
ActiveCell.Offset(0, 1).Value = Me.D_1.Text
ActiveCell.Offset(0, 2).Value = Me.D_2.Text
ActiveCell.Offset(0, 3).Value = Me.D_3.Text
ActiveCell.Offset(0, 4).Value = Me.D_4.Text
ActiveCell.Offset(0, 5).Value = Me.D_5.Text
ActiveCell.Offset(0, 6).Value = Me.D_6.Text



MsgBox "Los datos se guardarón correctamente", vbInformation
Else
MsgBox "Hay contenidos en la hoja" & vbCrLf & _
"No se anotan para no sobrescribirlos", vbOKOnly + vbExclamation
Call Proteger
End If
Call Unload(Me)



End Sub




Configuración: Windows / Firefox 72.0