Macro Excel para colorear texto y fondo en 5 celdas
Espero y deseo que estés bien
Esta parte de una macro, lo que hace es trasladar el color rojo y negrita del textbox a la celda de la columna 8 si el Checkbox3 esta marcado
wcolor = vbBlack: wbold = False If CheckBox3 Then wcolor = 3: wbold = True Cells(fil, col) = TextBox1 'Item # Cells(fil, col + 1) = TextBox2 'Producto # Cells(fil, col + 2) = TextBox3 'Descripcion del Producto Cells(fil, col + 8) = TextBox4 'Cant. Cells(fil, col + 8).Font.ColorIndex = wcolor Cells(fil, col + 8).Font.Bold = wbold Cells(fil, col + 9) = TextBox5 'Pagina #
Esto
Voy a agregar nuevo CheckBox para que traslade el rojo y bold de los 5 textBox a las 5 celdas que corresponden a cada TextBox y que dé fondo verde a las celdas
para esto
Hice esto con un For pero no me dio pié con bola porque no se como darle la línea para las 5 celdas de los 5 TextBox
' wcolor = vbBlack: wbold = False
' If CheckBox4 Then wcolor = 4: wbold = True
' For i = 1 To 5
' With Controls("TextBox" & i)
' .Cells(fil, col + 8).Font.ColorIndex = wcolor
' .Cells(fil, col + 8).Font.Bold = wbold
' End With
' End IfApelo a tu ayuda y conocimiento que para los expertos es facil pero para mi con 69 primaveras que ya pasaron es como correr un maraton de 50 Km
Tengo todo listo sobre el color y bold en los textBoxs, SOLO me falta el traslado a las celdas cuando pise el botón Insertar
2 Respuestas
No queda claro si la variable 'fil' será la misma para los 2 pases de datos.
En tu primer macro pasas los textbox a 5 col discontinuas y le asignas el color solo a una celda.
La siguiente macro pasa los textbox a 5 columnas continuas, empiezo en la 1 y luego se da color a todo el rango (col A:E):
wcolor = vbBlack: wbold = False 'pase de datos Cells(fil, 1) = TextBox1 'Item # Cells(fil, 2) = TextBox2 'Producto # Cells(fil, 3) = TextBox3 'Descripcion del Producto Cells(fil, 4) = TextBox4 'Cant. Cells(fil, 5) = TextBox5 'Pagina # If CheckBox4 Then wcolor = 3: wbold = True 'color a las 5 col With Range(Cells(fil, 1), Cells(fil, 5)) 'ajusta las col .Font.ColorIndex = wcolor .Font.Bold = wbold End With
Si esto no resuelve tu consulta aclara un poco más y que la imagen de la hoja deje ver los encabezados de fila/col.
Hola elsa
Como se ve en la imagen, la hoja se divide en Página 1 y página 2.
Pagia 1 desde la B hasta la QUE y página 2 desde M hasta V.
La Página 1 la voy llenando y cuando se llena la línea 46 de la página 1 (B11 hasta K46), el siguiente pasa a insertar en la página 2 (Línea M11 hasta V46). Esta la macro completa que hace 2 servicios, Inserta datos y Edita cuando se necesita editar datos de alguna línea
Y la parte para colorear el texto del textbox4 en la columna J o U del TextBox4, según si esta llena o no la Página 1.
Sub insertar()
'Por.Dante Amor
'Obligar a llenar las cajas del 6 al 9
Dim vcs, vtx, LastRow, u ', i
Dim i As Double
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="By Jot@"
Errores = False 'variable para verificar uno a uno o TODOS A LA VES los TextBox
'Insertar Ultimos datos
If CheckBox1 Then
'Mensage sobre TextBox para Datos Finales
'
If OptionButton1 = False And OptionButton2 = False Then
MsgBox "Selecciona una página"
Exit Sub
End If
'
vcs = Array("DTPicker1", "Textbox7", "Textbox8", "Textbox9", "Textbox10", "Textbox11")
vtx = Array("UNA FECHA VALIDA", "EL NOMBRE DE EMPRESA", "REPESTOS PARA", "EL SERIAL MAQ/MOT", "LA MARCA", "EL MODELO/IDENT.")
For i = LBound(vcs) To UBound(vcs)
If Me.Controls(vcs(i)) = Empty Then
MsgBox "DEBES INTRODUCIR: " & vtx(i), vbExclamation, "LLENAR LISTA"
Me.Controls(vcs(i)).SetFocus
Errores = True
End If
If Errores Then Exit Sub 'Colocado aqui, verifica uno a uno los TextBox
Next
'
If OptionButton1 Then
Range("C8") = DTPicker1 'Fecha
Range("E8") = TextBox7 'Nombre Empresa
Range("J8") = TextBox8 'Repuestos para
Range("D9") = TextBox9 'Serial Maq/Mot.
Range("G9") = TextBox10 'Marca
Range("K9") = TextBox11 'Modelo/Ident.
Range("D47").Value = Left(TextBox12.Value, 450) 'Notas
Else 'Si encuentra la C8 ya llena inserta en la 2ª pagina
Range("N8") = DTPicker1 'Fecha
Range("P8") = TextBox7 'Nombre Empresa
Range("U8") = TextBox8 'Repuestos para
Range("O9") = TextBox9 'Serial Maq/Mot.
Range("R9") = TextBox10 'Marca
Range("V9") = TextBox11 'Modelo/Ident.
Range("O47").Value = Left(TextBox12.Value, 450) 'Notas
End If
TextBox7.SetFocus
''''''''''''
Else
'Mensage sobre TextBox para Productos
vcs = Array("TextBox1", "Textbox2", "Textbox3", "Textbox4", "Textbox5")
vtx = Array("UN ITEM", "EL # DE PRODUCTO", "LA DESCRIPCION DEL PRODUCTO", "LA CANTIDAD", "EL # DE PAGINA")
For i = LBound(vcs) To UBound(vcs)
If Me.Controls(vcs(i)) = Empty Then
MsgBox "DEBES INTRODUCIR: " & vtx(i), vbExclamation, "LLENAR LISTA"
'Exit Sub 'Colocado este aqui, verifica uno a uno los TextBox. No hace parte de la variable errores
Me.Controls(vcs(i)).SetFocus
Errores = True
End If
If Errores Then Exit Sub 'Colocado aqui, verifica uno a uno los TextBox
Next
If CheckBox2 Then
'modifica producto
fil = Val(ComboBox1.List(ComboBox1.ListIndex, 2))
col = Val(ComboBox1.List(ComboBox1.ListIndex, 3))
Else
'inserta producto
fil = 11
col = Columns("B").Column
Do While Cells(fil, col) <> ""
fil = fil + 1
If fil = 47 Then col = Columns("M").Column: fil = 11
Loop
End If
'
wcolor = vbBlack: wbold = False
If CheckBox3 Then wcolor = 3: wbold = True
Cells(fil, col) = TextBox1 'Item #
Cells(fil, col + 1) = TextBox2 'Producto #
Cells(fil, col + 2) = TextBox3 'Descripcion del Producto
Cells(fil, col + 8) = TextBox4 'Cant.
Cells(fil, col + 8).Font.ColorIndex = wcolor
Cells(fil, col + 8).Font.Bold = wbold
Cells(fil, col + 9) = TextBox5 'Pagina #
Call CargaCombobox2
TextBox1.SetFocus
End If
ActiveSheet.Protect Password:="By Jot@"
Application.ScreenUpdating = True
Call Limpiar
ComboBox1 = ""
End Sub
Quiero mencionarte Elsa que algunas veces tengo la necesiodad de SOLO colorear rojo y negrita el texto del TextBox4, en J o U SOLAMENTE y otras tengo que colorear el texto en negrita la línea completa desde B hasta QUE o M hasta V según la página 1 o 2 en que inserto
Para la celda SOLA en J o U tengo el CheckBox3 NO siempre tengo o necesito colorear. Por ciertas circunstancias en algunos casos tengo que hacerlo, solo la celda del TextBox4 J o U
Y para la línea desde B hasta QUE o M hasta V el checkBox4 LAS 5 celdas de los 5 TextBox
Como también te respondió Adriel por favor dejale las aclaraciones a él también para que se ocupe, quizás pueda responderte antes que yo.
Sdos!
[Hola
Te paso la macro, agregado el color de fondo
wcolor = vbBlack: wbold = False 'pase de datos Cells(fil, 1) = TextBox1 'Item # Cells(fil, 2) = TextBox2 'Producto # Cells(fil, 3) = TextBox3 'Descripcion del Producto Cells(fil, 4) = TextBox4 'Cant. Cells(fil, 5) = TextBox5 'Pagina # ' If CheckBox4 Then wcolor = 3: wbold = True With Cells(u, "A").Resize(1, 5) .Interior.ColorIndex = 43 .Font.ColorIndex = wcolor .Font.Bold = wbold End With
Valora la respuesta ara finalizar saludos!
Me faltó cambiar un dato
wcolor = vbBlack: wbold = False 'pase de datos Cells(fil, 1) = TextBox1 'Item # Cells(fil, 2) = TextBox2 'Producto # Cells(fil, 3) = TextBox3 'Descripcion del Producto Cells(fil, 4) = TextBox4 'Cant. Cells(fil, 5) = TextBox5 'Pagina # ' If CheckBox4 Then wcolor = 3: wbold = True With Cells(fil, "A").Resize(1, 5) .Interior.ColorIndex = 43 .Font.ColorIndex = wcolor .Font.Bold = wbold End With
//s a l u d o s
Esta parte de la macro lo hace perfecto para lo que fue creada, sea en la página 1 o página 2
wcolor = vbBlack: wbold = False If CheckBox3 Then wcolor = 3: wbold = True 'SI EL CHECKBOX3 ESTA MARCADO Cells(fil, col) = TextBox1 'Item # Cells(fil, col + 1) = TextBox2 'Producto # Cells(fil, col + 2) = TextBox3 'Descripcion del Producto Cells(fil, col + 8) = TextBox4 'Cant. Cells(fil, col + 8).Font.ColorIndex = wcolor Cells(fil, col + 8).Font.Bold = wbold Cells(fil, col + 9) = TextBox5 'Pagina #
Tu codigo me hace esto Adriel
Pregunto si de este mismo código, ¿se podría hacer algo similar para las 5 celdas? Marcando un checkbox4, ¿el qué dice LÍNEA?
NO quisiera deshacerme de esta porque me funciona a perfección para tildar de rojo Negrita la celda en J o U
Envíame tu archivo y me explicas con un par de ejemplos. [email protected]