【目的】
パワーポイントを使用して、ロゴなどをベジェ曲線（フリーフォーム）で作成する際に、コントロールポイントが思った位置に配置できず困っていました。そこでVBAを使用して座標を数値として渡すことでフリーフォームが作れないか試行錯誤しました。ようやく思った通りの図形を作成することができましたので、備忘録としてここにまとめておきます。

【使用するサンプル図形】

サンプルの図形は2つ。一つは巴と言われる形です（図1）もう一つは、用具ブランドのロゴに似た形です（図2）

図1　すべて曲線のみです。一番上のポイントが開始点です。時計回りに図を描きます

図2　曲線と直線が混在しています。これも一番上のポイントが開始点です。時計回りに図を描きます

【頂点とコントロールポイント】

まず最初に、頂点とコントロールポイントの解析プログラムを使用して、どのようにデータが保存されているかを見てみます
プログラムNodeList（後述）を実行した結果が次の通りです

サンプル#1（曲線のみ）
頂点とコントロールポイントはこの図のとおり

これを解析すると次の表になります

サンプル#2（曲線・直線あり）

表の最後の列にある*の記号は、分かりやすくするために私がマークしました。
内部的には、頂点とコントロールポイントを区別するプロパティはありませんでした。

基本的なパターンは、頂点に二つのコントロールポイントが存在します。
コントロールポイント、頂点、コントロールポイントという組み合わせです。
（サンプル＃1のIndex4は2番目の頂点で、Index3と5がそのコントロールポイントとなります）
コントロールポイントが存在しない場合もあります。それは、直線（Line）の場合です。
（注意：頂点の編集モードにすると、画面上にはコントロールポイントが表示されますが、内部的には保有していません。）
直線の始点でそのひとつ前が曲線の場合は、コントロールポイントと頂点の2つです。（サンプル＃2のIndex6と7）
直線の終点でその後が直線の場合は、頂点のみです。（サンプル＃2のIndex8）
直線の終点でその後が曲線の場合は、頂点とコントロールポイントの2つです。（サンプル＃2のIndex9と10）

また、最初の頂点は、頂点とコントロールポイントの2つで、最後の頂点は、コントロールポイントと頂点の2つです。（直線のときを除く）

Edit（EditingType）は、コントロールポイントの働きを指定します。
・頂点を中心にスムージング（英語版：Smooth Point）
・頂点で線分を伸ばす（英語版： Straight Point）
・頂点を基準にする（英語版： Corner Point）
Smoothは、頂点がコントロールポイントの中間点になります
（サンプル＃1の開始点がこれにあたります。一方のコントロールポイントを移動すると、もう一方のコントロールポイントは頂点の反対側に自動で移動します）
Straightは、頂点がコントロールポイントの線上になりますが、距離が異なります
（サンプル＃1の2番目の頂点がこれにあたります。一方のコントロールポイントを移動すると、もう一方は頂点の延長線上になるように移動します）
Cornerは、二つのコントロールポイントが独立しています
（サンプル＃1の6番目の頂点がこれにあたります。コントロールポイントはそれぞれ自由に動かすことができます）

EditingTypeが”??”の項目がありますが、これは原因不明です。
値を取得することができませんでした。

Seg（SegmentType）は、直線か曲線かを指定します

詳細は、こちらをご覧ください
https://learn.microsoft.com/ja-jp/office/vba/api/powerpoint.shapenode
（ShapeNode オブジェクト (PowerPoint) | Microsoft Learn）

【プログラムを使って描画する CreatePoint関数】

入力するデータは､頂点ごとに必要となります。項目は次の8つ
・頂点のX座標
・頂点のY座標
・EditingType
・SegmentType
・頂点のひとつ前のコントロールポイントのX座標
・　　同 Y座標
・頂点のひとつ後ろのコントロールポイントのX座標
・　　同 Y座標

サンプルのパラメータは、視認性を意識して下記のような設定方法としました
注意点は次のとおり
・最初の頂点の項目5,6は不要のためゼロでOK
・最後の頂点の項目7,8は不要のためゼロでOK
・閉じた線を前提に作っています
・最初の頂点のEditingTypeは､BuildFreeformのルール上､Autoになるため何を指定しても問題ありません
･次が直線になる場合､項目7,8は不要のためゼロでOK
･直線の場合､項目5,6は不要のためゼロでOK
･EditingTypeは、マニュアル上は3（msoEditingSymmetric）が利用できることになっているが、このとき0（msoEditingAuto）とすること
　↑不具合またはマニュアルの修正漏れと思われる
・EditingTypeをSmoothにしたとき、頂点がコントロールポイントの座標の中間点にならなければいけないので、そうなっていないときはプログラム上でコントロールポイント＃2のX、Y座標を修正しています（ログが出力されます）
・EditingTypeをStraightにしたとき、頂点がコントロールポイント間の線上にならなければいけないので、そうなっていないときはプログラム上でコントロールポイント＃2のY座標を修正しています（ログが出力されます）

注意事項
・下記関数は両方ともPowerpointのスライド#2を前提としています
・頂点が同じ座標は存在しないという前提で作られています
・閉じた図形を前提にしています

Sub CreatePoint()

    Dim ww(19)
    'msoEditingAuto      0
    'msoEditingCorner    1
    'msoEditingSmooth    2 = straight
    'msoEditingSymmetric 3 = smooth(左右同じ)

'string xx, yy, SegType, EditType, CP1-X, CP1-Y, CP2-X, CP2-Y
'SegmentType: Line 0, Curve 1
'EditingType: Corner 1, Straight 2, Smooth 0 (3は使うとダメ Bug?)

ShapeN = "Sample1"
Select Case ShapeN
    Case "Sample2"
        ww(0) = Split("100 391 1 0 000 000 085 411")
        ww(1) = Split("091 433 1 2 089 424 094 442")
        ww(2) = Split("132 448 1 1 109 453 000 000")
        ww(3) = Split("341 393 0 0 000 000 000 000")
        ww(4) = Split("132 481 0 0 000 000 098 496")
        ww(5) = Split("064 479 1 2 072 493 059 470")
        ww(6) = Split("100 391 1 1 050 431 000 000")
    
    Case "Sample1"
        ww(0) = Split("200 400 1 0 000 000 250 400")
        ww(1) = Split("300 500 1 2 300 450 300 525")
        ww(2) = Split("250 550 1 0 275 550 225 550")
        ww(3) = Split("200 500 1 0 200 525 200 475")
        ww(4) = Split("150 450 1 0 175 450 125 450")
        ww(5) = Split("100 500 1 1 100 475 100 450")
        ww(6) = Split("200 400 1 0 150 400 000 000,")
    
    Case Else
        Debug.Print "ShapeN Error"
        Exit Sub
End Select
    
    For i = 0 To UBound(ww) 'wwMax
        On Error Resume Next
        If UBound(ww(i)) = 7 Then
            If Err <> 0 Then Exit For
            On Error GoTo 0
            wwMax = i
        Else
            Exit For
        End If
    Next
    
    'Smooth/Straightのとき､制御点1､頂点､制御点2が直線上にあるかどうかのチェック
    For i = 1 To wwMax  '1つ目はチェックしない
        If ww(i)(2) <> 0 Then '直線は対象外
            a1x = ww(i)(4): b1x = ww(i)(0): c1x = ww(i)(6)
            a1y = ww(i)(5): b1y = ww(i)(1): c1y = ww(i)(7)
            If i = wwMax Then '最後の頂点は最初の頂点と同じなので使う値は最初の頂点の制御点2
                c1x = ww(0)(6)
                c1y = ww(0)(7)
            End If
            
            Select Case ww(i)(3)
                Case 0 ' Smooth
                        If c1x * 1 <> b1x + (b1x - a1x) Or c1y * 1 <> b1y + (b1y - a1y) Then
                            c1x = b1x + (b1x - a1x)
                            c1y = b1y + (b1y - a1y)
                            Debug.Print "頂点-" & i & "は制御点の中間ではありません。制御点2の座標を修正しました　" & ww(i)(6) & "," & ww(i)(7) & " => " & c1x & "," & c1y
                            ww(i)(6) = c1x
                            ww(i)(7) = c1y
                        End If
                Case 2 ' Straight
                        w01 = (b1y - a1y) / (b1x - a1x)
                        w02 = (c1y - b1y) / (c1x - b1x)
                        If w01 <> w02 Then
                            y = (b1y - a1y) * (c1x - b1x) / (b1x - a1x) + b1y
                            Debug.Print "頂点-" & i & "の制御点と頂点が直線ではありません。制御点2のY座標を修正しました　 " & ww(i)(7) & " => " & y
                            ww(i)(7) = y
                        End If
                Case Else  ' Corner
            End Select
        End If
    Next
    
    wName = "Free01"
    Set myDocument = ActivePresentation.Slides(2)
    
    '--- Step 1 頂点を設定してオブジェクトを作る ------------------------------
    myDocument.Shapes(wName).Delete
    idx = myDocument.Shapes.Count
    
    With myDocument.Shapes.BuildFreeform(msoEditingAuto, ww(0)(0), ww(0)(1))
        'Debug.Print 0, msoEditingAuto, "-", ww(0)(0), " ", ww(0)(1), ww(0)(4), " ", ww(0)(5), " ", ww(0)(6), " ", ww(0)(7)
        For i = 1 To wwMax
            If ww(i)(3) = 0 Then wEdit = 0 Else wEdit = ww(i)(3) ' Line -> Auto
            Select Case wEdit
                Case 0 ' Auto
                    .AddNodes ww(i)(2), ww(i)(3), ww(i)(0), ww(i)(1)
                Case 1 ' Corner
                    .AddNodes ww(i)(2), ww(i)(3), ww(i)(4), ww(i)(5), ww(i)(6), ww(i)(7), ww(i)(0), ww(i)(1)
                Case Else '
                    .AddNodes ww(i)(2), ww(i)(3), ww(i)(0), ww(i)(1)
            End Select
            'Debug.Print i, ww(i)(2), ww(i)(3), ww(i)(0), , " ", ww(i)(1), ww(i)(4), " ", ww(i)(5), " ", ww(i)(6), " ", ww(i)(7)
        Next
        .ConvertToShape
    End With
    
    DoEvents
    myDocument.Shapes(idx + 1).Name = wName '"Free01"
    
    '--- Step 2 制御点の編集 ------------------------------
Step2:
    With myDocument.Shapes(wName).Nodes
        wk = .Count
        'Nodesの中は、頂点と制御点が両方格納されているので、頂点を調べる
        'そして、それぞれの頂点ごとに、Nodesのインデックスを保存する
        'これは、曲線だけならば頂点の前後は制御点となるが
        '直線が含まれると頂点の次も頂点になることがあるため、確認なしに位置を修正できないため
        Dim Summit() 'パラメータの数＝頂点の数なので、それぞれの頂点のNodesインデックスを保管
        Dim SummitF() 'それぞれのNodesが頂点なのか否か
        ReDim Summit(wwMax)
        ReDim SummitF(wk)
        
        For i = 0 To wk: SummitF(i) = 0: Next
        For j = wwMax To 0 Step -1
            Summit(j) = 0
            For i = wk To 1 Step -1 '後ろからやる必要はないと思われるがそのまま使った
                parr = .Item(i).Points
                cx = Round(parr(1, 1), 2)
                cy = Round(parr(1, 2), 2)
                If cx = ww(j)(0) * 1 And cy = ww(j)(1) * 1 Then
                    'Debug.Print "Match", j, i, ww(j)(0), ww(j)(1)
                    wk = i - 1
                    Summit(j) = i '頂点JのNodesIndexを保存
                    SummitF(i) = 1
                    Exit For
                Else
                    'Debug.Print "UnMatch", j, i, ww(j)(0), ww(j)(1), cX, cY
                End If
            Next
        Next
        
        '頂点の前後の制御点を修正する
        For j = wwMax To 0 Step -1
            i = Summit(j)
            If j <> 0 Then
                If SummitF(i - 1) <> 1 Then '
                    .SetPosition i - 1, ww(j)(4), ww(j)(5)
                End If
            End If
            If j <> wwMax Then
                If SummitF(i + 1) <> 1 Then
                    .SetPosition i + 1, ww(j)(6), ww(j)(7)
                End If
            End If
        Next
    End With
End Sub

解析プログラム

Sub NodeList(Optional ShapeName = "Free01")
        'オブジェクトのNode一覧
        'https://learn.microsoft.com/ja-jp/office/vba/api/powerpoint.shape.nodes
    
    Set MyShape = ActivePresentation.Slides(2).Shapes(ShapeName)
    With MyShape.Nodes
        Debug.Print "ShapeName:" & MyShape.Name, "Node:" & MyShape.Nodes.Count
        For i = 1 To .Count
            parr = .Item(i).Points
            cXvalue = parr(1, 1)
            cYvalue = parr(1, 2)
            
            On Error Resume Next
            ET = "??"
            ET = .Item(i).EditingType
            ST = "??"
            ST = .Item(i).SegmentType
            On Error GoTo 0
            Debug.Print i, cXvalue, cYvalue, ET, ST
        Next i
    End With
End Sub