Здравствуйте. Есть макрос расстановки соединительных линий между фигурами.
В ячейку E3 - вписывается название первой фигуры, а в ячейку E6 - название второй фигуры. Но это касается рисования линий. А вот как удалить соединительные линии - я не понимаю.
Подскажите как удалить соединительные линии (одну или несколько), соединяющие две указанные в этих ячейках фигуры ?
Здравствуйте. Есть макрос расстановки соединительных линий между фигурами.
В ячейку E3 - вписывается название первой фигуры, а в ячейку E6 - название второй фигуры. Но это касается рисования линий. А вот как удалить соединительные линии - я не понимаю.
Подскажите как удалить соединительные линии (одну или несколько), соединяющие две указанные в этих ячейках фигуры ?Megamen2
Sub Нарисовать() Dim o1 As Shape, o2 As Shape Set o1 = ActiveSheet.Shapes([E3]) Set o2 = ActiveSheet.Shapes([E6]) Dim x1!, y1!, r1!, x2!, y2!, r2!, xa!, ya!, xb!, yb! GetParam o1, x1, y1, r1 GetParam o2, x2, y2, r2 Dim i&, j&, p#, l!, lmin! Dim x1t!, y1t!, x2t!, y2t!, bc&, ec& p = Atn(1) lmin = [a65536].Top - [a1].Top For i = 0 To 7 x1t = x1 + Cos(p * i) * r1 y1t = y1 - Sin(p * i) * r1 For j = 0 To 7 x2t = x2 + Cos(p * j) * r2 y2t = y2 - Sin(p * j) * r2 l = Sqr((x1t - x2t) ^ 2 + (y1t - y2t) ^ 2) If l < lmin Then lmin = l xa = x1t ya = y1t xb = x2t yb = y2t bc = i ec = j End If Next Next With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, xa, ya, xb, yb) .ConnectorFormat.BeginConnect o1, (bc + 6) Mod 8 + 1 .ConnectorFormat.EndConnect o2, (ec + 6) Mod 8 + 1 .Name = [E3] & "|" & [E6] End With End Sub
Sub Удалить() On Error Resume Next ActiveSheet.Shapes([E3] & "|" & [E6]).Delete If Err = 0 Then Exit Sub Dim o1 As Shape, o2 As Shape, o3 As Shape, o4 As Shape Set o1 = ActiveSheet.Shapes([E3]) Set o2 = ActiveSheet.Shapes([E6]) For Each sh In ActiveSheet.Shapes If sh.Connector Then With sh.ConnectorFormat Set o3 = .BeginConnectedShape Set o4 = .EndConnectedShape If o1 Is o3 And o2 Is o4 Or o1 Is o4 And o2 Is o3 Then sh.Delete Exit For End If End With End If Next End Sub
[/vba]
Здравствуйте. Как-то так [vba]
Код
Sub Нарисовать() Dim o1 As Shape, o2 As Shape Set o1 = ActiveSheet.Shapes([E3]) Set o2 = ActiveSheet.Shapes([E6]) Dim x1!, y1!, r1!, x2!, y2!, r2!, xa!, ya!, xb!, yb! GetParam o1, x1, y1, r1 GetParam o2, x2, y2, r2 Dim i&, j&, p#, l!, lmin! Dim x1t!, y1t!, x2t!, y2t!, bc&, ec& p = Atn(1) lmin = [a65536].Top - [a1].Top For i = 0 To 7 x1t = x1 + Cos(p * i) * r1 y1t = y1 - Sin(p * i) * r1 For j = 0 To 7 x2t = x2 + Cos(p * j) * r2 y2t = y2 - Sin(p * j) * r2 l = Sqr((x1t - x2t) ^ 2 + (y1t - y2t) ^ 2) If l < lmin Then lmin = l xa = x1t ya = y1t xb = x2t yb = y2t bc = i ec = j End If Next Next With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, xa, ya, xb, yb) .ConnectorFormat.BeginConnect o1, (bc + 6) Mod 8 + 1 .ConnectorFormat.EndConnect o2, (ec + 6) Mod 8 + 1 .Name = [E3] & "|" & [E6] End With End Sub
Sub Удалить() On Error Resume Next ActiveSheet.Shapes([E3] & "|" & [E6]).Delete If Err = 0 Then Exit Sub Dim o1 As Shape, o2 As Shape, o3 As Shape, o4 As Shape Set o1 = ActiveSheet.Shapes([E3]) Set o2 = ActiveSheet.Shapes([E6]) For Each sh In ActiveSheet.Shapes If sh.Connector Then With sh.ConnectorFormat Set o3 = .BeginConnectedShape Set o4 = .EndConnectedShape If o1 Is o3 And o2 Is o4 Or o1 Is o4 And o2 Is o3 Then sh.Delete Exit For End If End With End If Next End Sub