XL 도형 - 두 셀 연결선

20230624 2250 

 

1, 두 셀 연결 - 박스 없이 직선으로 연결

Sub zConnectTwoCells_without_box_straightLine() 'beg x1 = Selection.Areas.Item(1).Left w1 = Selection.Areas.Item(1).Width y1 = Selection.Areas.Item(1).Top h1 = Selection.Areas.Item(1).Height 'end x2 = Selection.Areas.Item(2).Left y2 = Selection.Areas.Item(2).Top w2 = Selection.Areas.Item(2).Width h2 = Selection.Areas.Item(2).Height 'if beg is left of end If (x1 < x2) Then   ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1 + w1, y1 + h1 / 2, x2, y2 + h2 / 2).Select Else   ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, y1 + h1 / 2, x2 + w2, y2 + h2 / 2).Select End If With Selection.ShapeRange.Line   .BeginArrowheadStyle = msoArrowheadNone   .EndArrowheadStyle = msoArrowheadOpen   '.Weight = 1.75   .ForeColor.RGB = RGB(0, 0, 0) End With End Sub

2, 두 셀 연결 - 굴절선 & 박스 표시 

Sub zConnectTwoCells_with_box_and_kinked_line() zx = TypeName(Selection) 'rectangle 'zx = Selection.ShapeRange.ShapeStyle 'zx = Selection.ShapeRange.Type     Dim shp1 As Shape     Dim shp2 As Shape If zx = "Range" Then     x1 = Selection.Areas.Item(1).Left     w1 = Selection.Areas.Item(1).Width     y1 = Selection.Areas.Item(1).Top     h1 = Selection.Areas.Item(1).Height          x2 = Selection.Areas.Item(2).Left     y2 = Selection.Areas.Item(2).Top     w2 = Selection.Areas.Item(2).Width     h2 = Selection.Areas.Item(2).Height     '''add box     Set shp1 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, x1, y1, w1, h1)     Set shp2 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, x2, y2, w2, h2)          shp1.Fill.Visible = msoFalse     shp2.Fill.Visible = msoFalse Else     x1 = Selection.ShapeRange.Item(1).Left     w1 = Selection.ShapeRange.Item(1).Width     y1 = Selection.ShapeRange.Item(1).Top     h1 = Selection.ShapeRange.Item(1).Height          x2 = Selection.ShapeRange.Item(2).Left     y2 = Selection.ShapeRange.Item(2).Top     w2 = Selection.ShapeRange.Item(2).Width     h2 = Selection.ShapeRange.Item(2).Height          Set shp1 = Selection.ShapeRange.Item(1)     Set shp2 = Selection.ShapeRange.Item(2) End If Set conn = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, x1, y1, x2, y2) With conn.ConnectorFormat   conn.Line.ForeColor.RGB = RGB(0, 0, 255)   conn.Line.EndArrowheadStyle = msoArrowheadTriangle 'BeginArrowheadStyle   conn.Line.EndArrowheadLength = msoArrowheadLong   .BeginConnect ConnectedShape:=shp1, ConnectionSite:=2 '1=up, 2=left, 3=down, 4= right   .EndConnect ConnectedShape:=shp2, ConnectionSite:=1   conn.RerouteConnections 'optimization End With End Sub