如何在形状中移动节点?

时间:2018-01-09 12:20:46

标签: excel vba excel-vba

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

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

这是我到目前为止,宏在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

老实说,我不确定这是否可以完成,但即使不可能,最好还是确认一下:)

3 个答案:

答案 0 :(得分:2)

您正在寻找的是.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

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

答案 1 :(得分:1)

我相信使用Shapes.BuildFreeform Method将其作为自由格式绘制然后使用FreeformBuilder.ConvertToShape Method转换为形状会更简单。

示例:

vector<unsigned char> a = get_some_bytes(SOME_LENGTH);
unsigned char * b = &a[0];

答案 2 :(得分:0)

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

.Nodes.Delete 3

要访问具有nodes - 形状属性的所有节点,只要您处理标准形状类型,就无法访​​问坐标。

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

<强>更新 玩了一下(因为我很好奇) - 如果有人想手动改变形状的话就是一个例子:

    ' 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