Crear líneas inclinada en excel vba
H o l a: Dante buenas tardes necesito que me ayudes con una macro.
Necesito una macro para crear esta línea que está de color rojo, para realizar el cierre diario de mi reporte. El límite de filas es hasta el 20. Entonces la macro debe recorrer la fila hasta el último dato y crear la línea como te muestro en la imagen.
1 Respuesta
Respuesta de Dante Amor
1
Te anexo la macro
Sub LineaInclinada()
'Por.Dante Amor
'Borrando líneas anteriores
For Each s In ActiveSheet.Shapes
If s.Name = "linea1" Or s.Name = "linea2" Then
s.Delete
End If
Next
'
f = 5
Do While Cells(f, "B") <> ""
f = f + 1
Loop
f = f + 1
If f > 25 Then Exit Sub
'
Set r1 = Range("B" & f & ":B" & f)
Set r2 = Range("G" & f & ":G" & f)
Set r3 = Range("H25")
Set linea = ActiveSheet.Shapes.AddLine(r1.Left, r1.Top, r2.Left, r2.Top)
linea.Name = "linea1"
linea.Line.ForeColor.RGB = RGB(255, 0, 0)
linea.Line.Weight = 2
Set linea = ActiveSheet.Shapes.AddLine(r2.Left, r2.Top, r3.Left, r3.Top)
linea.Name = "linea2"
linea.Line.ForeColor.RGB = RGB(255, 0, 0)
linea.Line.Weight = 2
End SubSi quieres que la línea quede en medio de la fila, entonces ajusta el Top, como en el ejemplo:
Sub LineaInclinada()
'Por.Dante Amor
'Borrando líneas anteriores
For Each s In ActiveSheet.Shapes
If s.Name = "linea1" Or s.Name = "linea2" Then
s.Delete
End If
Next
'
f = 5
Do While Cells(f, "B") <> ""
f = f + 1
Loop
f = f + 1
If f > 25 Then Exit Sub
'
Set r1 = Range("B" & f & ":B" & f)
Set r2 = Range("G" & f & ":G" & f)
Set r3 = Range("H25")
Set linea = ActiveSheet.Shapes.AddLine(r1.Left, r1.Top - 7, r2.Left, r2.Top - 7)
linea.Name = "linea1"
linea.Line.ForeColor.RGB = RGB(255, 0, 0)
linea.Line.Weight = 2
Set linea = ActiveSheet.Shapes.AddLine(r2.Left, r2.Top - 7, r3.Left, r3.Top)
linea.Name = "linea2"
linea.Line.ForeColor.RGB = RGB(255, 0, 0)
linea.Line.Weight = 2
End Subsal u dos
