Perché la mia forma personalizzata non riempie correttamente in PowerPoint?

Question

Sto cercando di creare una serie di forme di codice (non chiedere perché ... hehehe). Sto usando i parametri forniti da Open XML per ricreare essi e stiamo lavorando bene, come la creazione di un cuore. In alcuni casi, posso creare la forma, ma non riempie correttamente.

Ecco il codice XML da DrawingML per una forma 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>

E qui è come ricreare questo 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

E 'funziona bene per creare il contorno (è possibile copiare / incollare in un modulo di PowerPoint VBA per farlo funzionare), ma quando provo a riempirlo con un colore, sia a livello di codice o manualmente, si riempie solo la metà della forma. Tutte le idee su come posso riempire tutta la forma con un colore?

Answer 1

Rimuovere l'ultimo AddNode, (questo uno: .AddNodes msoSegmentLine, msoEditingAuto, r, y2). Che funziona per me.