Pourquoi ma forme personnalisée ne se remplit-elle pas correctement dans PowerPoint?

Question

J'essaye 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 les recréer et certains fonctionnent bien, comme créer un cœur. Dans certains cas, je peux créer la forme, mais elle ne se 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éer cela 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 PowerPoint VBA pour l'exécuter), mais lorsque j'essaie de le remplir avec une couleur, soit par programmation soit manuellement, il ne remplit que la moitié de la forme. Des idées sur comment je peux remplir toute la forme avec une couleur?

Answer 1

Enlever le dernier AddNode, (celui-ci: .AddNodes msoSegmentLine, msoEditingAuto, r, y2). Ça marche pour moi.