Jump to content

autoformato al ingresar nuevo dato


aprendiz

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 2 weeks later...

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.

×
×
  • Create New...

Important Information

Privacy Policy