Formato condicional actualizable.-

Tengo una formulario al cual me extrae de una base de datos, fechas de vencimiento al cual he logrado que en el textbox que las trae me refleje el color rojo con el cual esta en la base de datos, la base de datos esta con un formato condicional el cual cuando hay una fecha vencida menor que la fecha actual esta cambia el color avisando de su vencimiento, la cuestión es que cuando actualizo con el formulario las fecha y vuelvo a la planilla base esta no cambia el formato y el formato condiciona no se ejecuta ni actualiza el color de la fecha, por lo tanto la idea es que al momento de actualizar la base de datos con el formulario echo en visual de excel 2010, al salir de este me cambien el color de las fechas en las celdas respectivas.

1 Respuesta

Respuesta
1

Tienes que cambiar el formato del textbox, ya que en el textbox tienes un texto, lo tienes que convertir a fecha.

Utiliza las siguientes líneas

Range("D5") = Format(TextBox1.Value, "mm/dd/yyyy")
TextBox1 = Range("D5")

Lo anterior es suponiendo que en D5 tienes la celda con el formato condicional y que el textbox se llama texbox1, cambia estos datos por tus datos reales.

Prueba y me comentas.

Saludos. Dam
Si es lo que necesitas.

Hola disculpa si es mas o menos lo que estaba buscando, pero no es mi caso de referenciar hacia una celda especifica, te dejo el código para que lo analices.:

Option Explicit
Dim rango As Range
Private Sub CommandButton1_Click()
If ComboBox1 = "" Then
MsgBox "Ingresar Apellido y Nombre completo para buscar sus referencias by: [email protected]", vbOKOnly + vbInformation, "AVISO"
ComboBox1.SetFocus
Exit Sub
End If
Set rango = Range("A:A").Find(What:=ComboBox1, _
LookAt:=xlWhole, LookIn:=xlValues)
If rango Is Nothing Then
MsgBox "El dato no existe-- by: [email protected]", vbOKOnly + vbInformation, "AVISO"
ComboBox1 = "": ComboBox1.SetFocus
Exit Sub
Else
TextBox2 = Range("B" & rango.Row)
TextBox3 = Range("C" & rango.Row)
TextBox4 = Range("D" & rango.Row)
TextBox5 = Range("E" & rango.Row)
TextBox6 = Range("N" & rango.Row)
TextBox7 = Range("M" & rango.Row)
TextBox8 = Range("H" & rango.Row)
TextBox9 = Range("O" & rango.Row)
TextBox10 = Range("P" & rango.Row)
TextBox11 = Range("Q" & rango.Row)
TextBox12 = Range("L" & rango.Row)
TextBox13 = Range("R" & rango.Row)
TextBox14 = Range("S" & rango.Row)
TextBox15 = Range("U" & rango.Row)
TextBox16 = Range("T" & rango.Row)
TextBox17 = Range("V" & rango.Row)
TextBox18 = Range("W" & rango.Row)
TextBox21 = Range("X" & rango.Row)
TextBox22 = Range("Y" & rango.Row)
TextBox23 = Range("z" & rango.Row)
End If
End Sub
Private Sub CommandButton2_Click()
Dim ctr As Control
If rango Is Nothing Then
MsgBox "Busca un dato antes de editar-- by: [email protected]", vbOKOnly + vbInformation, "AVISO"
ComboBox1.SetFocus
Exit Sub
End If
If TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Then
MsgBox "No dejar ningún campo en vacío-- by: [email protected]", vbOKOnly + vbInformation, "AVISO"
Exit Sub
End If
Range("B" & rango.Row) = TextBox2
Range("C" & rango.Row) = TextBox3
Range("D" & rango.Row) = TextBox4
Range("E" & rango.Row) = TextBox5
Range("N" & rango.Row) = TextBox6
Range("M" & rango.Row) = TextBox7
Range("H" & rango.Row) = TextBox8
Range("O" & rango.Row) = TextBox9
Range("P" & rango.Row) = TextBox10
Range("Q" & rango.Row) = TextBox11
Range("L" & rango.Row) = TextBox12
Range("R" & rango.Row) = TextBox13
Range("S" & rango.Row) = TextBox14
Range("U" & rango.Row) = TextBox15
Range("T" & rango.Row) = TextBox16
Range("V" & rango.Row) = TextBox17
Range("W" & rango.Row) = TextBox18
Range("X" & rango.Row) = TextBox21
Range("Y" & rango.Row) = TextBox22
Range("z" & rango.Row) = TextBox23
For Each ctr In Me.Controls
If TypeOf ctr Is MSForms.TextBox Then
ctr = ""
End If
Next ctr
ComboBox1.SetFocus
ComboBox1 = Empty
MsgBox "Operación realizada con éxito! - by: [email protected]", vbOKOnly + vbInformation, "AVISO"
Set ctr = Nothing
Set rango = Nothing
End Sub
Private Sub CommandButton3_Click()
Dim strfila$, ctr As Control
If ComboBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Then
MsgBox "Si desea ingresar un registro nuevo No dejar ningún campo en blanco-- by: [email protected]", vbOKOnly + vbInformation, "AVISO"
ComboBox1.SetFocus
Exit Sub
End If
Set rango = Range("A:A").Find(What:=ComboBox1, _
LookAt:=xlWhole, LookIn:=xlValues)
If Not rango Is Nothing Then
MsgBox "El dato ya existe-- by: [email protected]", vbOKOnly + vbInformation, "AVISO"
ComboBox1.SetFocus
Exit Sub
End If
strfila$ = [B65536].End(xlUp).Offset(1, 0).Row
Range("A" & strfila$) = ComboBox1
Range("B" & strfila$) = TextBox2
Range("C" & strfila$) = TextBox3
Range("D" & strfila$) = TextBox4
Range("E" & strfila$) = TextBox5
Range("N" & strfila$) = TextBox6
Range("M" & strfila$) = TextBox7
Range("H" & strfila$) = TextBox8
Range("O" & strfila$) = TextBox9
Range("P" & strfila$) = TextBox10
Range("Q" & strfila$) = TextBox11
Range("L" & strfila$) = TextBox12
Range("R" & strfila$) = TextBox13
Range("S" & strfila$) = TextBox14
Range("U" & strfila$) = TextBox15
Range("T" & strfila$) = TextBox16
Range("V" & strfila$) = TextBox17
Range("W" & strfila$) = TextBox18
Range("X" & strfila$) = TextBox21
Range("Y" & strfila$) = TextBox22
Range("z" & strfila$) = TextBox23
For Each ctr In Me.Controls
If TypeOf ctr Is MSForms.ComboBox Then
ctr = ""
End If
Next ctr
Range("A" & strfila$ & ":A" & strfila$).HorizontalAlignment = xlCenter
ComboBox1.SetFocus
ComboBox1 = Empty
End Sub
Private Sub CommandButton4_Click()
Dim respuesta As Integer, ctr As Control
If rango Is Nothing Then
MsgBox "Busca el dato a eliminar-- by: [email protected]", vbOKOnly + vbInformation, "AVISO"
ComboBox1.SetFocus
Exit Sub
End If
respuesta = MsgBox("¿Estas seguro que deseas eliminar el registro elegido?", vbCritical + vbOKCancel, "AVISO")
respuesta = MsgBox("¿Aun puedes calcelar la operacion, deseas continuar??", vbCritical + vbOKCancel, "AVISO")
If respuesta = vbOK Then
Cells(rango.Row, rango.Column).EntireRow.Delete
For Each ctr In Me.Controls
If TypeOf ctr Is MSForms.TextBox Then
ctr = ""
End If
Next ctr
ComboBox1.SetFocus
ComboBox1 = Empty
Exit Sub
End If
MsgBox "Operación cancelada-- by: [email protected]", vbOKOnly + vbInformation, "AVISO"
For Each ctr In Me.Controls
If TypeOf ctr Is MSForms.TextBox Then
ctr = ""
End If
Next ctr
ComboBox1.SetFocus
ComboBox1 = Empty
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub TextBox10_Change()
End Sub
Private Sub TextBox11_Change()
End Sub
Private Sub TextBox13_Change()
End Sub
Private Sub TextBox14_Change()
Me.TextBox14.ForeColor = ActiveCell.Font.Color
End Sub
Private Sub TextBox15_Change()
End Sub
Private Sub TextBox16_Change()
End Sub
Private Sub TextBox17_Change()
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub TextBox21_Change()
End Sub
Private Sub TextBox22_Change()
Me.TextBox22.ForeColor = ActiveCell.Font.Color
End Sub
Private Sub TextBox23_Change()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub TextBox4_Change()
End Sub
Private Sub TextBox6_Change()
End Sub
Private Sub TextBox7_Change()
End Sub
Private Sub TextBox9_Change()
End Sub

Disculpa por lo extenso es que sin no no me vas a entender, si presizars que te deje el archivo avisame y lo hago , gracias por la celeridad de las respuestas..

¿Pero en qué parte tienes el problema?

En tu pregunta inicial comentas: "la idea es que al momento de actualizar la base de datos con el formulario "

En el ejemplo que te envié, tienes que modificar el formato del textbox al momento que lo pasas a tu base.

Tienes 23 textbox, y no me dices cuál es el que tiene el problema de la fecha.

El formato condicional de la celda no se activa, porque lo que estás poniendo es un texto, por eso, antes de ponerlo, lo tienes que formatear a fecha.

Espero tus comentarios.

Si quieres que adapte el código, necesito, además de tu archivo, que me expliques cómo funciona tu macro y exactamente en qué parte tienes el problema.

Saludos. Dam

Hola de nuevo, aca te dejo el archivo para que lo veas, sobre la columna de mails esta el botón que llama a la macro , en el textbox vencimientos , de todos los vencimientos es en donde quiero que me salga el dato real , si esta vencido en rojo, y si esta vigente( apto) el formato condicional de la hoja funcione como debería. espero ser claro, mil disculpas.-

http://www.4shared.com/rar/GD8i3WyE/PLANILLA_PRUBa_01.html

La liga que me enviaste, me marca error y no puedo bajar el archivo, puedes poner nuevamente el enlace o también puedes enviar el archivo a mi correo.

Saludos. Dam

Hola te dejo los archivos, espero que me puedas ayudar en esto, mi cabeza no da mas, je je gracias.-

http://www.mediafire.com/?jk0k59dm19knkje,m32judac1oersa5

Me sigue enviando error la liga.

Saludos. Dam

Añade tu respuesta

Haz clic para o