2

我有一系列从第三方应用程序复制的自由形状。

这些自由形状由开放路径组成，不能在 PowerPoint 中“组合”（只有用封闭路径制成的自由形状可以组合）。

下面的宏会遍历每个选定的形状，如果是自由形状，它将创建一个封闭路径的副本，然后删除原始形状。

    Sub close_poly()


        Dim myshp As Shape
        Dim mycol As String
        Dim mynode As ShapeNode

        Dim myxvals As Variant
        Dim myyvals As Variant

        Dim myxcol As String
        Dim myycol As String

        Dim myffb As FreeformBuilder
        Dim mynewshp As Shape
        Dim myname As String


        For Each myshp In ActiveWindow.Selection.ShapeRange

            With myshp
                If .Type = msoFreeform Then


                    '################ set all line segments to straight
                    '(makes things easier in my specific case but will not work in many)
                    nodecount = 1
                    While nodecount <= .Nodes.Count
                        .Nodes.SetSegmentType nodecount, msoSegmentLine
                        nodecount = nodecount + 1
                    Wend

                    '############## collect coordinates
                     myxcol = ""
                     myycol = ""
                    For Each mynode In myshp.Nodes
                       myxcol = myxcol & mynode.Points(1, 1) & ","
                       myycol = myycol & mynode.Points(1, 2) & ","
                    Next
                    myxcol = Left(myxcol, Len(myxcol) - 1)
                    myycol = Left(myycol, Len(myycol) - 1)

                    myxvals = Split(myxcol, ",")
                    myyvals = Split(myycol, ",")


                    '##############create new freeform


                    Set myffb = ActiveWindow.View.Slide.Shapes.BuildFreeform(msoEditingAuto, myxvals(0), myyvals(0))
                        For i = 1 To UBound(myxvals)
                            myffb.AddNodes msoSegmentLine, msoEditingAuto, myxvals(i), myyvals(i)
                        Next i
                        myffb.AddNodes msoSegmentLine, msoEditingAuto, myxvals(0), myyvals(0)
                    Set mynewshp = myffb.ConvertToShape

                    myshp.PickUp
                    mynewshp.Apply

                    myname = myshp.Name
                    myshp.Delete

                    mynewshp.Name = myname

                End If
            End With


        Next myshp
End Sub

问题：有没有更简单的方法来模仿 VBA 中程序的“关闭路径”功能？

干杯

4

0 回答 0