Requiero código para cambiar de color una linea que crea un macro
Tengo una macro que me crea líneas azules, lo único que tengo que hacer es cambiar el color de las líneas a negro, para Dante Amor.
El código es
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("L8")) Is Nothing Then
'Borrando líneas anteriores
For Each s In ActiveSheet.Shapes
If s.Name = "milineacreada" Then
s.Delete
End If
Next
'
Set r = Range("B17:D49, G17:I49")
Set B = r.Find("CALIF", lookat:=xlWhole)
If Not B Is Nothing Then
celda = B.Address
Do
'Creando líneas
If Cells(B.Row + 1, B.Column) = "" Then
Set r1 = Cells(B.Row + 1, B.Column)
fila = B.Row + 1
Do While Cells(fila, B.Column).HasFormula
fila = fila + 1
Loop
Set r2 = Cells(fila, B.Column + 3)
Set linea = ActiveSheet.Shapes.AddLine(r1.Left, r1.Top, r2.Left, r2.Top)
linea.Name = "milineacreada"
End If
Set B = r.FindNext(B)
Loop While Not B Is Nothing And B.Address <> celda
End If
End If
End Sub
H o l a : Hay que agregar esta línea
linea.Line.ForeColor.RGB = RGB(0, 0, 0)
Te anexo la macro actualizada
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("L8")) Is Nothing Then
'Borrando líneas anteriores
For Each s In ActiveSheet.Shapes
If s.Name = "milineacreada" Then
s.Delete
End If
Next
'
Set r = Range("B17:D49, G17:I49")
Set B = r.Find("CALIF", lookat:=xlWhole)
If Not B Is Nothing Then
celda = B.Address
Do
'Creando líneas
If Cells(B.Row + 1, B.Column) = "" Then
Set r1 = Cells(B.Row + 1, B.Column)
fila = B.Row + 1
Do While Cells(fila, B.Column).HasFormula
fila = fila + 1
Loop
Set r2 = Cells(fila, B.Column + 3)
Set linea = ActiveSheet.Shapes.AddLine(r1.Left, r1.Top, r2.Left, r2.Top)
linea.Name = "milineacreada"
linea.Line.ForeColor.RGB = RGB(0, 0, 0)
End If
Set B = r.FindNext(B)
Loop While Not B Is Nothing And B.Address <> celda
End If
End If
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
