Editar (arreglo) de copdigo Excel para color de texto en celda

Para dante Amor

Hola Dante

Tuve que agregar If para que pudiera deshacer el coloreado, tanto de texto como de fondo

Sub Formatear(fil, col, wcolor, wbold, wtext)
    Cells(fil, col) = wtext
    Cells(fil, col).Font.ColorIndex = wcolor
    Cells(fil, col).Font.Bold = wbold
    If CheckBox4 Then
        Cells(fil, col).Interior.ColorIndex = 43
    Else
        Cells(fil, col).Interior.ColorIndex = 0
    End If
End Sub

Si no está bien, te pido su corrección

Ahora la falla:

Tengo el CheckBox4 (LÍNEA) marcado como ves, y responde a todos (los 5) TextBox

Resulta que no me integra el color rojo en la celda de columna que corresponde, U por ser página 2

Las macros (códigos) para los 5 (TextBox4) y para solo 1 (TextBox3), los tengo así dentro de la macro Sub Insertar()

''''''
        wcolor = vbBlack: wbold = False
        If CheckBox4 Then wcolor = 3: wbold = True
        Call Formatear(fil, col, wcolor, wbold, TextBox1.Value)
        Call Formatear(fil, col + 1, wcolor, wbold, TextBox2.Value)
        Call Formatear(fil, col + 2, wcolor, wbold, TextBox3.Value)
        Call Formatear(fil, col + 8, wcolor, wbold, TextBox4.Value)
        Call Formatear(fil, col + 9, wcolor, wbold, TextBox5.Value)
        '
        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

Si coloco al inverso los 2 codigos, es peor aun porque la del CheckBox3 luego se encuentra con el Call Formatear y es mucho peor, asi lo tenia y tuve que cambiar sus posiciones

Mi pregunta es sobre la figura arriba, si tieme alguna solucion, por no me integrar el color rojo en la celda de columna que corresponde, U por ser pagina 2

1 respuesta

Respuesta
1

Te anexo el código actualizado

Sub insertar()
'Por.Dante Amor http://www.todoexpertos.com/preguntas/6dfdswlh5iak7bjd/correccion-para-macro-excel-para-insertar-datos-mandando-error
'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@"
    'quita colores
    Range("B11:K46, M11:V46").Font.ColorIndex = vbBlack
    Range("B11:K46, M11:V46").Font.Bold = wbold
    Range("B11:K46, M11:V46").Interior.ColorIndex = 0
    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
                'Exit Sub 'Colocado este aqui, verifica uno a uno los TextBox. No hace parte de la variable errores
                Errores = True
            End If
            If Errores Then Exit Sub 'Colocado aqui, verifica uno a uno los TextBox
        Next
        'If errores Then Exit Sub 'Colocado aqui, verifica TODOS TextBox a la ves
        '
        'If Range("c8") = "" Then 'SI LA C8 ESTA VACIA, INSERTA EN LA 1ª PAGINA
        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 errores Then Exit Sub 'Colocado aqui, verifica TODOS TextBox a la ves
        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 CheckBox4 Then wcolor = 3: wbold = True
        Call Formatear(fil, col, wcolor, wbold, TextBox1.Text)
        Call Formatear(fil, col + 1, wcolor, wbold, TextBox2.Text)
        Call Formatear(fil, col + 2, wcolor, wbold, TextBox3.Text)
        Call Formatear(fil, col + 8, wcolor, wbold, TextBox4.Text)
        Call Formatear(fil, col + 9, wcolor, wbold, TextBox5.Text)
        '
'        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@"
    Call Limpiar
    ComboBox1 = ""
    'Subir la hoja
    If Range("C46") = "" Then
        'Obtener la última fila con datos de la columna B
        u = Range("B" & Rows.Count).End(xlUp).Row
        'Si la ventana tiene los paneles inmovilizados, entonces n va a ser igual a 10 de lo contrario n =17
        If ActiveWindow.FreezePanes = True Then n = 16 Else n = 23  'original es 10  17
        'Ahora si la última fila con dato es mayor a 17, significa que tengo que mover los datos de la ventana "scroll"
        'Entonces voy a mover la ventana haciendo un scroll hasta la última fila pero le resto las filas que quiero que permanezcan visibles.
        If u > 23 Then ActiveWindow.ScrollRow = u - n
    Else
        'Obtener la última fila con datos de la columna M
        u = Range("M" & Rows.Count).End(xlUp).Row
        If ActiveWindow.FreezePanes = True Then n = 16 Else n = 23 'original es 10  17 Se puede jugar con estos números
        If u > 23 Then ActiveWindow.ScrollRow = u - n 'Original 17
    End If
    Application.ScreenUpdating = True
End Sub

sal u dos

Hola Dante

Gracias por tu tiempo

Este código no esta repetido, yo no lo veo repetido, en el archivo que te envíe

'        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 #

Este es para CUANDO SOLO necesito insertar el texto del TextBox4 a rojo en la cela J o U. Al desactivar este codigo del CheckBox3 queda sin efecto la inserción del texto rojo en la celdaEl del CheckBox4 es para toda la línea. Necesito tener los 2 tanto del CheckBox4 como el del CheckBox3, para cuando necesite de uno o de otroEl evento

Private Sub CheckBox3_Click()

Como lo sabes es SOLAMENTE para que el texto EN EL TextBox4 se vea rojo nada mas

Entonces revisa bien la lógica, ya que esa parte es la que hace que el dato se quede en negro.

Podría ser así, solamente si el chec3 está activo, entonces que ponga los datos y los colores de acuerdo al check3

        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 #
       end if

sal u dos

Así esta pero ¿y si marco el ChecBox4 para toda la línea? ¿Y el CheckBox3 esta desmarcado?

Entonces para toda la línea tendtre que marcar los 2 CheckBox4 y el 3

No, así no está, revisa el nuevo código, todo el cambio está dentro del 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 #
       end if

revisa bien

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas