necesito mover un conector o linea segun este un rango de celdas vacios o sea se me deberia quedar sin mover en la esquina de la celda AE12 y solamente bajar en la columna B mientras esten las filas vacias de forma automatica. Probe con este codigo y lo he tratado de modificar pero no lo logro.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row = 2 And Target.Column = 1 Then
Call SizeCircle("Linea1", Val(Target.Value))
End If
End Sub
Sub SizeCircle(Name As String, Diameter)
Dim xCenterX As Single
Dim xCenterY As Single
Dim xLinea As Shape
Dim xDiameter As Single
Dim wksNew As Worksheet
necesito mover un conector o linea segun este un rango de celdas vacios o sea se me deberia quedar sin mover en la esquina de la celda AE12 y solamente bajar en la columna B mientras esten las filas vacias de forma automatica. Probe con este codigo y lo he tratado de modificar pero no lo logro.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row = 2 And Target.Column = 1 Then
Call SizeCircle("Linea1", Val(Target.Value))
End If
End Sub
Sub SizeCircle(Name As String, Diameter)
Dim xCenterX As Single
Dim xCenterY As Single
Dim xLinea As Shape
Dim xDiameter As Single
Dim wksNew As Worksheet
On Error GoTo ExitSub
xDiameter = Diameter
Set xLinea = ActiveSheet.Shapes(Name)
With xLinea
.Left = "50"
.Top = "70"
.Width = "300"
.Height = Application.CentimetersToPoints(xDiameter)
End With
If xDiameter = "1" Then
'xLinea = ActiveChart.Shapes.AddConnector
Set xLinea = ActiveSheet.Shapes.AddShape(msoShapeLineInverse, 50, 50, 200, 100)
'xLinea.Rotation = "71"
Else
wksNew.Shapes.Delete
End If
ExitSub:
End Sub
Linea.xlsm