Pourquoi ne forme pas mon personnalisé remplir correctement dans PowerPoint?

Question

Je suis en train de créer un certain nombre de formes automatiques dans le code (ne demandez pas pourquoi ... hehehe). J'utilise les paramètres fournis par Open XML pour recréer eux et certains travaillent bien, comme la création d'un cœur. Dans certains cas, je peux créer la forme, mais il ne remplit pas correctement.

Voici le XML à partir DrawingML pour une forme de FoldedCorner:

  <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>

Et voici comment je recrée ceci dans 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

Il fonctionne très bien pour créer le contour (vous pouvez copier / coller dans un module VBA PowerPoint pour l'exécuter), mais lorsque je tente de le remplir avec une couleur, soit par programme ou manuellement, il ne remplit que la moitié de la forme. Toutes les idées sur la façon dont je peux remplir la forme entière avec une couleur?

Answer 1

Supprimer le dernier AddNode, (celui-ci: .AddNodes msoSegmentLine, msoEditingAuto, r, y2). Qui fonctionne pour moi.