Vba 如何在形状中的节点周围移动？

我正在尝试在Excel中创建一个Sankey图表，作为开始，我正在尝试为图表的左侧部分创建一些“输入箭头”，大致如下所示： 我创建它是通过制作一个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

---

老实说，我不确定这是否可以做到，但即使这是不可能的，也很高兴得到确认：）

我相信这将更简单，使用自由形式绘制，然后使用转换为形状

例如：

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

---

我相信这将是更简单的画这作为自由形式使用，然后转化为形状使用

例如：

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

---

如果只想删除右侧的点，只需删除节点（从左上角开始按顺时针方向计算V形节点数）：

但是，要使用形状的

节点

-属性访问所有节点，只要处理标准形状类型，就无法访问坐标

使用“编辑点”时，形状将其类型更改为

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

---

如果只想删除右侧的点，只需删除节点（从左上角开始按顺时针方向计算V形节点数）：

但是，要使用形状的

节点

-属性访问所有节点，只要处理标准形状类型，就无法访问坐标

使用“编辑点”时，形状将其类型更改为

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

---

您要查找的是

.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位置，我们希望在最上面的角上的第一个点，所以我们使用顶部的形状。最后一点，我们将高度添加到顶部位置，以使其位于下角。

您要查找的是

.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位置，我们希望在最上面的角上的第一个点，所以我们使用顶部的形状。最后一点，我们将高度添加到顶部位置，使其位于底部。

我甚至无法编译您的代码。你没有在任何地方定义

Tabell

。当我认为德国人是唯一在VBA代码中使用

u

和

ß

的人时，我看到了这一点。为什么？@braX-

Tabell

可能是

Sheet1的VBA代码（在德语中，它是
Tabelle1
，因此非常相似。因此，它没有在任何地方定义，并且仍然可以编译。我甚至无法让您的代码进行编译。您没有在任何地方定义
Tabell
。当我认为德国人是唯一在VBA代码中使用
u
和
ß
的人时，我看到了这个-
ø
。）hy？@braX-
Tabell
可能是
Sheet1
的VBA代码（在德语中，它是
Tabelle1
，因此非常相似。因此它没有在任何地方定义，并且仍然可以编译。