3
我试图在代码中创建一些自选图形（不要问为什么...... hehehe）。我正在使用Open XML提供的参数来重新创建它们，有些工作正常，比如创建一个心脏。在某些情况下，我可以创建形状，但不能正确填充。为什么我的自定义形状在PowerPoint中不能正确填充？
下面是从DrawingML的XML的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>
这里是我如何重建这个在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
它工作得很好，创造大纲（您可以复制/粘贴到一个PowerPoint VBA模块来运行它），但是当我尝试用一种颜色来填充它，以编程方式或手动，它只是填充一半的形状。我如何能使用一种颜色填充整个造型任何想法？