Vba 为什么'；我的自定义形状不能在PowerPoint中正确填充吗？

我试图在代码中创建一些自选图形（不要问为什么…呵呵）。我正在使用OpenXML提供的参数来重新创建它们，有些参数工作正常，比如创建心脏。在某些情况下，我可以创建形状，但不能正确填充

以下是DrawingML中用于折叠角形状的XML：

  <foldedCorner>
    <avLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main">
      <gd name="adj" fmla="val 16667" />
    </avLst>
    <gdLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main">
      <gd name="a" fmla="pin 0 adj 50000" />
      <gd name="dy2" fmla="*/ ss a 100000" />
      <gd name="dy1" fmla="*/ dy2 1 5" />
      <gd name="x1" fmla="+- r 0 dy2" />
      <gd name="x2" fmla="+- x1 dy1 0" />
      <gd name="y2" fmla="+- b 0 dy2" />
      <gd name="y1" fmla="+- y2 dy1 0" />
    </gdLst>
    <ahLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main">
      <ahXY gdRefX="adj" minX="0" maxX="50000">
        <pos x="x1" y="b" />
      </ahXY>
    </ahLst>
    <cxnLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main">
      <cxn ang="3cd4">
        <pos x="hc" y="t" />
      </cxn>
      <cxn ang="cd2">
        <pos x="l" y="vc" />
      </cxn>
      <cxn ang="cd4">
        <pos x="hc" y="b" />
      </cxn>
      <cxn ang="0">
        <pos x="r" y="vc" />
      </cxn>
    </cxnLst>
    <rect l="l" t="t" r="r" b="y2" xmlns="http://schemas.openxmlformats.org/drawingml/2006/main" />
    <pathLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main">
      <path stroke="false" extrusionOk="false">
        <moveTo>
          <pt x="l" y="t" />
        </moveTo>
        <lnTo>
          <pt x="r" y="t" />
        </lnTo>
        <lnTo>
          <pt x="r" y="y2" />
        </lnTo>
        <lnTo>
          <pt x="x1" y="b" />
        </lnTo>
        <lnTo>
          <pt x="l" y="b" />
        </lnTo>
        <close />
      </path>
      <path stroke="false" fill="darkenLess" extrusionOk="false">
        <moveTo>
          <pt x="x1" y="b" />
        </moveTo>
        <lnTo>
          <pt x="x2" y="y1" />
        </lnTo>
        <lnTo>
          <pt x="r" y="y2" />
        </lnTo>
        <close />
      </path>
      <path fill="none" extrusionOk="false">
        <moveTo>
          <pt x="x1" y="b" />
        </moveTo>
        <lnTo>
          <pt x="x2" y="y1" />
        </lnTo>
        <lnTo>
          <pt x="r" y="y2" />
        </lnTo>
        <lnTo>
          <pt x="x1" y="b" />
        </lnTo>
        <lnTo>
          <pt x="l" y="b" />
        </lnTo>
        <lnTo>
          <pt x="l" y="t" />
        </lnTo>
        <lnTo>
          <pt x="r" y="t" />
        </lnTo>
        <lnTo>
          <pt x="r" y="y2" />
        </lnTo>
      </path>
    </pathLst>
  </foldedCorner>

下面是我如何在VBA中重新创建的：

Sub DrawFoldedCornerfromPresetShape()
    Dim w As Single
    Dim h As Single
    Dim adj As Single
    adj = 16667
    w = 200
    h = 200
    Dim L, T, r, B As Single
    L = 0: T = 0: r = w: B = h
    Dim a, DY2, DY1, x1, x2, y2, y1 As Single
    a = Pin(0, adj, 50000)
    DY2 = MultiplyDivide(Min(w, h), a, 100000)
    DY1 = MultiplyDivide(DY2, 1, 5)
    x1 = AddSubtract(r, 0, DY2)
    x2 = AddSubtract(x1, DY1, 0)
    y2 = AddSubtract(B, 0, DY2)
    y1 = AddSubtract(y2, DY1, 0)
    Dim sh2 As Shape

    With ActivePresentation.Slides(1).Shapes.BuildFreeform(msoEditingAuto, L, T)
        ''# this is the first in the path list
        .AddNodes msoSegmentLine, msoEditingAuto, r, T
        .AddNodes msoSegmentLine, msoEditingAuto, r, y2
        .AddNodes msoSegmentLine, msoEditingAuto, x1, B
        .AddNodes msoSegmentLine, msoEditingAuto, L, B
        ''# this is the second in the path list
        .AddNodes msoSegmentLine, msoEditingAuto, x1, B ''# moveto
        .AddNodes msoSegmentLine, msoEditingAuto, x2, y1
        .AddNodes msoSegmentLine, msoEditingAuto, r, y2
        ''# this is the Third in the path list
        .AddNodes msoSegmentLine, msoEditingAuto, x1, B ''# moveto
        .AddNodes msoSegmentLine, msoEditingAuto, x2, y1
        .AddNodes msoSegmentLine, msoEditingAuto, r, y2
        .AddNodes msoSegmentLine, msoEditingAuto, x1, B
        .AddNodes msoSegmentLine, msoEditingAuto, L, B
        .AddNodes msoSegmentLine, msoEditingAuto, L, T
        .AddNodes msoSegmentLine, msoEditingAuto, r, T
        .AddNodes msoSegmentLine, msoEditingAuto, r, y2
         Set sh2 = .ConvertToShape
    End With
End Sub
'used for fmla in Preset Autoshapes
Function Min(ByVal w As Single, ByVal h As Single) As Single
    If w < h Then Min = w Else Min = h
End Function
Function Pin(ByVal x As Single, ByVal y As Single, ByVal z As Single) As Single
    If (y < x) Then
        Pin = x
    ElseIf (y > z) Then
            Pin = z
    Else: Pin = y
    End If
End Function
Function MultiplyDivide(ByVal x As Single, ByVal y As Single, ByVal z As Single) As Single
    MultiplyDivide = ((x * y) / z)
End Function
Function AddSubtract(ByVal x As Single, ByVal y As Single, ByVal z As Single) As Single
    AddSubtract = ((x + y) - z)
End Function

子图纸FolderdCornerFromPresetShape（）
暗w为单色
将h变为单个
暗淡的，暗淡的
adj=16667
w=200
h=200
单件尺寸L、T、r、B
L=0:T=0:r=w:B=h
尺寸a、DY2、DY1、x1、x2、y2、y1为单个
a=引脚（0，调整，50000）
DY2=多分裂体（最小（宽，高），a，100000）
DY1=多晶硅（DY2，1，5）
x1=AddSubtract（r，0，DY2）
x2=AddSubtract（x1，DY1，0）
y2=AddSubtract（B，0，DY2）
y1=加法减法（y2，DY1，0）
暗sh2 As形状
使用ActivePresentation.Slides（1）.Shapes.BuildFreeform（msoEditingAuto，L，T）
''这是路径列表中的第一个
.AddNodes msoSegmentLine、msoEditingAuto、r、T
.AddNodes msoSegmentLine、msoEditingAuto、r、y2
.AddNodes msoSegmentLine、msoEditingAuto、x1、B
.AddNodes msoSegmentLine、msoEditingAuto、L、B
''这是路径列表中的第二个
.AddNodes msoSegmentLine、msoEditingAuto、x1、B''移动到
.AddNodes msoSegmentLine、msoEditingAuto、x2、y1
.AddNodes msoSegmentLine、msoEditingAuto、r、y2
''这是路径列表中的第三个
.AddNodes msoSegmentLine、msoEditingAuto、x1、B''移动到
.AddNodes msoSegmentLine、msoEditingAuto、x2、y1
.AddNodes msoSegmentLine、msoEditingAuto、r、y2
.AddNodes msoSegmentLine、msoEditingAuto、x1、B
.AddNodes msoSegmentLine、msoEditingAuto、L、B
.AddNodes msoSegmentLine、msoEditingAuto、L、T
.AddNodes msoSegmentLine、msoEditingAuto、r、T
.AddNodes msoSegmentLine、msoEditingAuto、r、y2
设置sh2=.ConvertToShape
以
端接头
'用于预设自选图形中的fmla
最小功能（ByVal w为单个，ByVal h为单个）为单个
如果wz）那么
Pin=z
其他：Pin=y
如果结束
端函数
函数MultiplyDivide（ByVal x为单变量，ByVal y为单变量，ByVal z为单变量）为单变量
多分割=（（x*y）/z）
端函数
函数AddSubtract（ByVal x为单精度，ByVal y为单精度，ByVal z为单精度）为单精度
AddSubtract=（（x+y）-z）
端函数

---

创建轮廓效果很好（您可以复制/粘贴到PowerPoint VBA模块中运行它），但当我尝试以编程方式或手动方式使用颜色填充轮廓时，它只填充一半的形状。关于如何用颜色填充整个形状有什么想法吗？

删除最后一个

AddNode

，（这一个：

.AddNodes msoSegmentLine，msoEditingAuto，r，y2

）。这对我很有用