queria preguntar como se hace para que al ingresar un nuevo dato desde un formulario ingrese tambien el formato de celdas (borde, ancho, alineacion) y las formulas?

intente grabando una macro con la grabadora de macros, pero se me hizo mucho codigo con solo el formato de celda... muchisimo... demasiado... exagerado... y no logro exagerar lo suficiente para acercarme a la exageracion...

DEPRECIACION 3.rar

Saludos.

Utiliza una tabla.

Selecciona donde quieres que se ingresen los datos, Barra de herramientas, insertar, tabla, con esto lograras que cada vez que ingreses un dato se copien formatos, formulas, etc.

Atte.

joshua

mmm eso en excel 2003 mi hoja no puede tener fondo es decir no hay limite para el cuadro ya que se ingresara muchos datos ... mmmm lo voy a intentar ya te cuento

no logro hacerlo no encuentro la opcion en insertar....

Private Sub BtnGrabarDatos_Click()

On Error Resume Next


For i = 1 To Val(ReCantidad) Step 1


Range("B5:W5").Copy

Range("B6").Select


Do While Not IsEmpty(ActiveCell)

    ActiveCell.Offset(1, 0).Select

Loop


ActiveSheet.Paste

Selection.RowHeight = 13


ActiveCell = CDbl(ReCodigo)

ActiveCell.Offset(0, 1) = ReCategoria


If IsNumeric(ReNuFactura) Then

     ActiveCell.Offset(0, 2) = CDbl(ReNuFactura)

  Else

     ActiveCell.Offset(0, 2) = ReNuFactura

End If


ActiveCell.Offset(0, 3).FormulaR1C1 = "=SUMPRODUCT(1*(R5C4:R65536C4=RC4))"

ActiveCell.Offset(0, 4).FormulaR1C1 = Evaluate("=ROW()-6")


If ReReferencia.Enabled = False Then

    ActiveCell.Offset(0, 5) = ""

    ElseIf IsNumeric(ReReferencia) Then

         ActiveCell.Offset(0, 5) = CDbl(ReReferencia)

      Else

         ActiveCell.Offset(0, 5) = ReReferencia

 End If


ActiveCell.Offset(0, 6) = ReDescripcion

ActiveCell.Offset(0, 7) = ReFecha

ActiveCell.Offset(0, 8) = Date

ActiveCell.Offset(0, 10) = ReEstado


 If ReVaUnitario1.Enabled = True Then

     ActiveCell.Offset(0, 11) = CDbl(ReVaUnitario1)

  Else

     ActiveCell.Offset(0, 11) = CDbl(ReVaUnitario2)

 End If


ActiveCell.Offset(0, 12).FormulaR1C1 = "=SUMPRODUCT((R5C4:R65536C4=RC4)*R5C13:R65536C13)"

ActiveCell.Offset(0, 13).FormulaR1C1 = "=IF(RC17=0,0,DATEDIF(RC9,R1C1+1,""Y""))"

ActiveCell.Offset(0, 14).FormulaR1C1 = "=IF(RC17=0,0,DATEDIF(RC9,R1C1+1,""YM""))"

ActiveCell.Offset(0, 15).FormulaR1C1 = "=IF(DAYS360(RC9,R1C1)<0,0,DAYS360(RC9,R1C1))"

ActiveCell.Offset(0, 17).FormulaR1C1 = "=DACUM(RC13,DEP(RC2),RC17)"

ActiveCell.Offset(0, 18).FormulaR1C1 = "=IF(RC17=0,0,IF(RC17<30,DACUM(RC13,DEP(RC2),RC17),DMEN(RC13,DEP(RC2))))"

ActiveCell.Offset(0, 19).FormulaR1C1 = "=IF(RC17=0,0,IF(RC17<360,DACUM(RC13,DEP(RC2),RC17),IF(DED(RC2)-RC17>=360,RC13*DEP(RC2),IF(DED(RC2)-RC17=0,"""",DACUM(RC13,DEP(RC2),RC17)))))"

ActiveCell.Offset(0, 20).FormulaR1C1 = "=IF(RC[-3]=0,0,IF(RC[-5]=0,0,RC[-9]-RC[-3]))"

ActiveCell.Offset(0, 21).FormulaR1C1 = "=IF(RC[-4]=0,0,IF(RC[-6]=0,0,RC[-9]-DACUM(RC[-9],DEP(RC[-21]),RC[-6])))"


Next i


Application.CutCopyMode = False

  VCantidad1 = ""

  VCantidad2 = ""

  VUnitario1 = ""

  VUnitario2 = ""

     VTotal1 = ""

     VTotal2 = ""


Unload Me

End Sub


[/CODE]

asi parece que lo rsolvi un poco sucio pero bueno funciona

Hola aprendiz

Te he dado una idea en https://www.ayudaexcel.com/foro/macros-programacion-vba-10/pendiente-no-me-pega-formato-fila-21687/, y me acabo de percatar que ya lo habías intentado. No obstante, como consejo, a fin de que la grabadora no te suture con código innecesario limita la operación al máximo. Por ejemplo selecciona una celda y dale la anchura deseada. Para la grabadora y observa el resultado. Después haz otra modificación (nuevamente con la grabadora en marcha), etc.

Un saludo desde Vitoria

si tenes razon de hecho eso pensaba con los bordes y lo hice pero me genera tanto codigo que no se como depurarlos

intente por ejemplo con una parte del formato

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = 50

    End With

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = 50

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = 50

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = 50

End Sub[/CODE]

de la sigueinte forma las puse pero sin funionarme

[CODE]Range("B14:L14").Select Selection.Borders(xlDiagonalDown And xlDiagonalUp And xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft And xlEdgeBottom And xlEdgeRight And xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 50
End With


Range("M14:N14").Select
Selection.Borders(xlDiagonalDown And xlDiagonalUp And xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft And xlEdgeBottom And xlEdgeRight And xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 10
End With
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With


Range("O14:R14").Select
Selection.Borders(xlDiagonalDown And xlDiagonalUp And xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom And xlEdgeRight And xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 45
End With


Range("S14:U14").Select
Selection.Borders(xlDiagonalDown And xlDiagonalUp And xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft And xlEdgeBottom And xlEdgeRight And xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 50
End With


Range("V14:W14").Select
Selection.Borders(xlDiagonalDown And xlDiagonalUp And xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft And xlEdgeBottom And xlEdgeRight And xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 10
End With
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With[/CODE]

Copia de DEPRECIACION 42.rar