【Word VBA】ベジェ曲線作成マクロ▽ソースコード

左の表にデータを入力して、作成のボタンをクリックすると、そのデータに基づく、ベジェ曲線を描画します。表には、Ｘ、Ｙの１０組の位置情報を入力します。

Option Explicit

Option Base 0

Public Sub ベジェ曲線作成マクロ()

    Const BEZIXPOS = 200 　　　　　　　'ベジェ曲線オフセットＸ

    Const BEZIYPOS = 80 　　　　　　　  '       　                    Ｙ

    Const BEZIBAIR = 2                           'ベジェ曲線描画倍率

    '---------------------------------------------------------------------------

    Dim Ip As Integer, Jp As Integer, strDat As String

    Dim celData As Cell, sngBezi(9, 1) As Single

    If ActiveDocument.Tables.Count < 1 Then Exit Sub

    '

    With ActiveDocument.Tables(1)

         '*セルデータ取り込み

         For Each celData In .Range.Cells

             strDat = celData.Range.Text

             sngBezi(celData.RowIndex - 1, celData.ColumnIndex - 1) = _

             CSng("0" & Left(strDat, Len(strDat) - 2))

         Next celData

    End With

    '

    '*ベジェ曲線があれば、消去

    If ActiveDocument.Shapes.Count = 1 Then

        ActiveDocument.Shapes.Item(1).Delete

     End If

    '

    '*ベジェ曲線座標を加工

    For Ip = LBound(sngBezi, 1) To UBound(sngBezi, 1)

        sngBezi(Ip, 0) = (sngBezi(Ip, 0) * BEZIBAIR) + BEZIXPOS

        sngBezi(Ip, 1) = (sngBezi(Ip, 1) * BEZIBAIR) + BEZIYPOS

    Next Ip

    '

    '*ベジェ曲線描画

    With ActiveDocument.Shapes.AddCurve(sngBezi)

         .Line.ForeColor.RGB = vbGreen

         .Line.Weight = 2

    End With

End Sub

Private Sub CommandButton1_Click()    'ボタンのクリックイベント

    Call ベジェ曲線作成マクロ

End Sub