Why doesn't my custom shape fill properly in PowerPoint?

Question

I'm trying to create a number of AutoShapes in code (don't ask why...hehehe). I am using the parameters supplied by Open XML to re-create them and some are working okay, like creating a heart. In some cases, I can create the shape, but it doesn't fill properly.

Here's the XML from DrawingML for a FoldedCorner shape:

  <foldedCorner>
    <avLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main"&gt;
      <gd name="adj" fmla="val 16667" />
    </avLst>
    <gdLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main"&gt;
      <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"&gt;
      <ahXY gdRefX="adj" minX="0" maxX="50000">
        <pos x="x1" y="b" />
      </ahXY>
    </ahLst>
    <cxnLst xmlns="http://schemas.openxmlformats.org/drawingml/2006/main"&gt;
      <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"&gt;
      <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>

And here is how I recreate this in 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

It works just fine to create the outline (you can copy/paste into a PowerPoint VBA module to run it), but when I try to fill it with a color, either programmatically or manually, it only fills half the shape. Any ideas on how I can fill the whole shape with a color?

Answer 1

Remove the last AddNode, (this one: .AddNodes msoSegmentLine, msoEditingAuto, r, y2). That works for me.