如何在形状中移动节点？

I am trying to create a Sankey-diagram in Excel, and as a start to this, I am trying to create some "entry arrows" for the left part of the diagram, which will look roughly like this: I created it by making a chevron arrow, and dragging the rightmost points of it to line up with the tip of the arrow.

我试图在Excel中创建一个Sankey图,作为一个开始,我试图为图的左侧部分创建一些“入口箭头”,它看起来大致如下:我通过创建它创建它雪佛龙箭头,并拖动它的最右边的点与箭头的尖端对齐。

Now, to do this for all the arrows I need, I want to do this programmatically, but I can't figure out if there is any way to do much with the nodes (?) of the shape. Trying to record a macro gave me nothing.

现在,要为我需要的所有箭头执行此操作,我想以编程方式执行此操作,但我无法弄清楚是否有任何方法可以对形状的节点(?)做很多事情。试图录制宏给了我什么。

This is what I have so far, the macro aborts on the Debug.Print line, probably because the node object doesn't have a Left property :P

这是我到目前为止,在Debug.Print行上的宏中止,可能是因为节点对象没有Left属性:P

Sub energiInn()
    Dim r As Range, c As Range
    Dim lo As ListObject
    Dim topp As Double, høgde As Double
    Dim i As Long, farge As Long
    Dim nd As Object

    Set lo = Tabell.ListObjects("Energi_inn_elektrolyse")
    Set r = lo.DataBodyRange
    topp = 50

    With SankeyDiagram.Shapes
        For i = 1 To r.Rows.Count
            høgde = Application.WorksheetFunction.Max(10, r.Cells(i, 2) / 50#)
            With .AddShape(Type:=msoShapeChevron, Left:=50, top:=topp, Width:=200, Height:=høgde)
                .Name = r.Cells(i, 1)
                farge = fargekart((i - 1) Mod UBound(fargekart))
                .Fill.ForeColor.RGB = RGB(farge Mod 256, (farge \ 256) Mod 256, farge \ 65536)
                For Each nd In .Nodes
                    Debug.Print nd.Left
                Next nd
            End With
            topp = topp + høgde
        Next i
    End With
    Debug.Print r.Address

End Sub

Honestly, I am unsure if this can be done at all, but even if it is impossible, it would be nice to get it confirmed :)

老实说,我不确定这是否可以完成,但即使不可能,也很高兴得到它确认:)

3 个解决方案

#1

What you're looking for is .Nodes.SetPosition. Because it's relative positioning, this can be a challenge. You need to use the objects position elements to make sure the points are moving in relation to the shape.

你要找的是.Nodes.SetPosition。因为它的相对定位,这可能是一个挑战。您需要使用对象位置元素来确保点相对于形状移动。

With .AddShape(Type:=msoShapeChevron, Left:=50, Top:=topp, Width:=200, Height:=høgde)
    .Name = r.Cells(i, 1)
    .Nodes.SetPosition 2, .Left + .Width, .Top
    .Nodes.SetPosition 4, .Left + .Width, .Top + .Height

First argument is the node index. Next is the x position, which we want all the way to the right of the graphic, so we add the shapes position left to the width of the shape. Last is the y position, first point we want in the topmost corner, so we use the shapes top. Last point, we add the height to the top position to bring to the bottom corner.

第一个参数是节点索引。接下来是x位置,我们想要一直到图形的右边,所以我们将形状位置添加到形状的宽度。最后是y位置,我们想要在最顶端的第一个点,所以我们使用形状顶部。最后一点,我们将高度添加到顶部位置以带到底角。

#2

I believe it would be more simple drawing this as free form using Shapes.BuildFreeform Method and then converting to shape using FreeformBuilder.ConvertToShape Method.

我相信使用Shapes.BuildFreeform方法将其绘制为*形式然后使用FreeformBuilder.ConvertToShape方法转换为形状会更简单。

Example:

Sub drawEntryArrow()
  Dim x1 As Single, y1 As Single, w As Single, h As Single
  Dim oShape As Shape

  x1 = 10
  y1 = 10

  w = 200
  h = 200

  With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x1, y1)
   .AddNodes msoSegmentLine, msoEditingAuto, x1 + w, y1
   .AddNodes msoSegmentLine, msoEditingAuto, x1 + w, y1 + h
   .AddNodes msoSegmentLine, msoEditingAuto, x1, y1 + h
   .AddNodes msoSegmentLine, msoEditingAuto, x1 + w / 2, y1 + h / 2
   .AddNodes msoSegmentLine, msoEditingAuto, x1, y1
   Set oShape = .ConvertToShape
  End With

End Sub

#3

If you just want to get rid of the point at the right, you can simply delete the node (nodes of a chevron are counted clockwise starting at the top left):

如果你只想摆脱右边的点,你可以简单地删除节点(从左上角开始顺时针计算人字形的节点):

.Nodes.Delete 3

To get access to all nodes with the nodes-property of a shape, however, as long as you deal with a standard shape type, you can't access the coordinates.

但是,要使用形状的nodes-property访问所有节点,只要处理标准形状类型,就无法访问坐标。

When you use the "edit points", a shape changes its type to msoShapeNotPrimitive - but I couldn't figure out how to do this using VBA.

当您使用“编辑点”时,形状会将其类型更改为msoShapeNotPrimitive - 但我无法弄清楚如何使用VBA执行此操作。

UPDATE Played around a bit (because I'm curious) - just as an example if someone wants to change a shape manually:

更新玩了一下(因为我很好奇) - 只是有人想要手动更改形状的例子:

    ' First change Shape Type: 
    ' WILL NOT WORK: sh.AutoShapeType = msoShapeNotPrimitive
    ' Instead, add a node and remove it immediately. This changes the shape type.
    .Nodes.Insert c, msoSegmentLine, msoEditingCorner, 100, 100
    .Nodes.Delete c + 1

    ' Now access the x-coordinate of node 2 and the y-coordinate of node 3
    ' (note that we cannot access the coordinates directly)
    Dim pointsArray() As Single, x As Single, y As Single
    pointsArray = .Nodes(2).Points
    x = pointsArray(1, 1)
    pointsArray = .Nodes(3).Points
    y = pointsArray(1, 2)
    ' Now change the x-value of node 3
    sh.Nodes.SetPosition 3, x, y

#1