Attribute VB_Name = "Module1"
'******************************************************************************
'*                               セル操作関数                                 *
'******************************************************************************
'
'コンフィギュレーション識別番号：Cel-Ver2.0
'  配布用に変更記録削除
'　2018/11/27　　原作者
'
' SelectTargetRange：選択されているセル範囲を取得し、GetTargetRange関数に伝達する（イベント駆動関数から呼び出される）。
' GetTargetRange   ：演算対象セルの選択範囲を取得する（セル範囲をマニュアル設定する場合に使用）。
' RangeToCellRange ：セル範囲指定データをRange型からCellRange型に変換する。
' CXXXArray        ：任意型の配列データをXXX型の配列データに変換する。
'   CDblArray                       倍精度型
'   CIntArray                       整数型（２バイト長）
'   CLngArray                       整数型（４バイト長）
' GetXXXXXX        ：シートからXXXXXX型データを取得する関数（関数またはマクロから呼び出される）。
'   GetArray                        任意型の配列データ
'   GetGeoGraphicQuantities         地理関連諸量
'   GetInertialFrame                慣性座標系規定データ
'   GetMatrix3x3                    マトリクス（３ｘ３）
'   GetOrbitalElements              軌道要素
'   GetQuaternion                   四元数
'   GetTable                        汎用テーブルデータ
'   GetSiteLocation                 地上局位置データ
'   GetTrajectoryStateVariables     飛行状態量
'   GetVariant                      任意型のデータ
'   GetVector3D                     ３次元ベクトル
'   GetVectorND                     Ｎ次元ベクトル
' GetXXXXXXRange   ：関数引数で範囲指定されたXXXXXX型データをシートから取得する関数（シート関数（ｅｘｅ関数を使用しない）から呼び出される）。
'   GetArrayRange                   関数引数で範囲指定された任意型の配列データ
'   GetMatrix3x3Range               関数引数で範囲指定されたマトリクス（３ｘ３）
'   GetQuaternionRange              関数引数で範囲指定された四元数
'   GetVariantRange                 関数引数で範囲指定された任意型のデータ
'   GetVector3DRange                関数引数で範囲指定された３次元ベクトル
'   GetVectorNDRange                関数引数で範囲指定されたＮ次元ベクトル
' PutXXXXXX        ：シートへXXXXXX型データを格納する関数（マクロ（Sub)のみから呼び出される）。
'   PutArray                        任意型の配列データ
'   PutGeoGraphicQuantities         地理関連諸量
'   PutMatrix3x3                    マトリクス（３ｘ３）
'   PutOrbitalElements              軌道要素
'   PutQuaternion                   四元数
'   PutTrajectoryStateVariables     飛行状態量
'   PutVariant                      任意型のデータ
'   PutVector3D                     ３次元ベクトル
'   PutViewQuantities               視野情報
' PutArrayRange      関数引数で範囲指定された任意の型のデータをシートに設定する

Option Explicit

'型定義
    Public Type CellRange 'セルの範囲
        Row As Long             'セルの行番号
        Column As Long          'セルの列番号
        RowCount As Long        'セルの行数
        ColumnCount As Long     'セルの列数
        Value As Variant        '即値データ（セル指定でなく、定数）
    End Type

'変数定義
    Public TargetRange As CellRange '操作対象セルの範囲
    
Function CDblArray(v() As Variant, d() As Double) As Boolean

'任意型の配列データを倍精度型の配列データに変換する

' V()    ：入力、任意型配列データ
' d()    ：出力、倍精度型配列データ

    Dim L As Long
    Dim U As Long
    Dim i As Long

    L = LBound(v)
    U = UBound(v)
    ReDim d(L To U)
    For i = L To U
        d(i) = CDbl(v(i))
    Next i
    CDblArray = True

End Function
Function CIntArray(v() As Variant, d() As Integer) As Boolean

'任意型の配列データを整数型の配列データに変換する

' V()    ：入力、任意型配列データ
' d()    ：出力、整数型配列データ

    Dim L As Long
    Dim U As Long
    Dim i As Long

    L = LBound(v)
    U = UBound(v)
    ReDim d(L To U)
    For i = L To U
        d(i) = CInt(v(i))
    Next i
    CIntArray = True

End Function
Function CLngArray(v() As Variant, d() As Long) As Boolean

'任意型の配列データを長整数型の配列データに変換する

' V()    ：入力、任意型配列データ
' d()    ：出力、長整数型配列データ

    Dim L As Long
    Dim U As Long
    Dim i As Long

    L = LBound(v)
    U = UBound(v)
    ReDim d(L To U)
    For i = L To U
        d(i) = CLng(v(i))
    Next i
    CLngArray = True

End Function
Function GetArray(a() As Variant, TargetRange As CellRange) As Boolean

'任意型の配列データをシートから取得する
'  （行方向から先に取り出す）

' a()        ：出力、任意型配列データ
' TargetRange：入力、セル範囲

    Dim i As Long, j As Long, k As Long

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        ReDim Preserve a(TargetRange.RowCount * TargetRange.ColumnCount)
        k = 0
        For j = 1 To TargetRange.ColumnCount
            For i = 1 To TargetRange.RowCount
                k = k + 1
                a(k) = Selection.Cells(i, j).Value
            Next i
        Next j
        GetArray = True
    Else
        GetArray = False
    End If

End Function
Function GetArrayRange(a() As Variant, r As Range) As Boolean

'関数引数で範囲指定された任意の型のデータをシートから取得する
'  （行方向から先に取り出す）

' a()    ：出力、任意型配列データ
' r      ：入力、セル範囲

    Dim i As Long, j As Long, k As Long
    Dim nR As Long, nC As Long
    
    If (r.Row > 0 And r.Column > 0) Then
        nR = r.Rows.Count
        nC = r.Columns.Count
        ReDim Preserve a(nR * nC)
        k = 0
        For j = 1 To nC
            For i = 1 To nR
                k = k + 1
                a(k) = r.Cells(i, j).Value
            Next i
        Next j
        GetArrayRange = True
    Else
        GetArrayRange = False
    End If

End Function
Function GetGeoGraphicQuantities(g As GeoGraphicQuantities, TargetRange As CellRange) As Boolean

'地理関連諸量をシートから取得する

' G          ：出力、地理関連諸量
' TargetRange：入力、セル範囲

    g.Vi = 0#
    g.Fpvi = 0#
    g.Azvi = 0#
    g.Atli = 0#
    g.Amis = 0#
    g.Rlat = 0#

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 6 And TargetRange.ColumnCount = 1) Then
            g.ri = Selection.Cells(1, 1).Value          '地心半径
            g.Vltc = Selection.Cells(2, 1).Value        '地心緯度
            g.Vlni = Selection.Cells(3, 1).Value        '慣性座標Ｘ軸からの経度
            g.alt = Selection.Cells(4, 1).Value         '高度
            g.Vlat = Selection.Cells(5, 1).Value        '測地緯度
            g.Vlng = Selection.Cells(6, 1).Value        '経度
            If (TargetRange.RowCount >= 9) Then
                g.Vi = Selection.Cells(7, 1).Value      '慣性速度
                g.Fpvi = Selection.Cells(8, 1).Value    '慣性速度上下角
                g.Azvi = Selection.Cells(9, 1).Value    '慣性速度方位角
            End If
            If (TargetRange.RowCount >= 12) Then
                g.Atli = Selection.Cells(10, 1).Value   '機軸上下角
                g.Amis = Selection.Cells(11, 1).Value   '機軸方位角
                g.Rlat = Selection.Cells(12, 1).Value   'バンク角
            End If
            GetGeoGraphicQuantities = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 6) Then
            g.ri = Selection.Cells(1, 1).Value          '地心半径
            g.Vltc = Selection.Cells(1, 2).Value        '地心緯度
            g.Vlni = Selection.Cells(1, 3).Value        '慣性座標Ｘ軸からの経度
            g.alt = Selection.Cells(1, 4).Value         '高度
            g.Vlat = Selection.Cells(1, 5).Value        '測地緯度
            g.Vlng = Selection.Cells(1, 6).Value        '経度
            If (TargetRange.ColumnCount >= 9) Then
                g.Vi = Selection.Cells(1, 7).Value      '慣性速度
                g.Fpvi = Selection.Cells(1, 8).Value    '慣性速度上下角
                g.Azvi = Selection.Cells(1, 9).Value    '慣性速度方位角
            End If
            If (TargetRange.ColumnCount >= 12) Then
                g.Atli = Selection.Cells(1, 10).Value   '機軸上下角
                g.Amis = Selection.Cells(1, 11).Value   '機軸方位角
                g.Rlat = Selection.Cells(1, 12).Value   'バンク角
            End If
            GetGeoGraphicQuantities = True
        Else
            GetGeoGraphicQuantities = False
        End If
    Else
        GetGeoGraphicQuantities = False
    End If
    If (Not GetGeoGraphicQuantities) Then
         MsgBox "選択範囲が不正です。" & vbCrLf _
            & "(位置関連,[速度関連],[姿勢関連])の６or９or１２個"
    End If

End Function
Function GetInertialFrame(p As InertialFrame, TargetRange As CellRange) As Boolean

'慣性座標系規定データの取得

' p          ：出力、慣性座標系規定データ
' TargetRange：入力、セル範囲

    Dim fmOntime As hhmmss
        
    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 3 And TargetRange.ColumnCount = 1) Then
            p.Y0Day.Yr = Year(Selection.Cells(1, 1).Value)  '発射年月日
            p.Y0Day.Mn = Month(Selection.Cells(1, 1).Value)
            p.Y0Day.Dy = day(Selection.Cells(1, 1).Value)
            p.Xtime.hr = Hour(Selection.Cells(2, 1).Value)  '発射時刻
            p.Xtime.min = Minute(Selection.Cells(2, 1).Value)
            p.Xtime.sec = Second(Selection.Cells(2, 1).Value) _
                        + Selection.Cells(3, 1).Value       '発射時刻の小数秒時
            If (TargetRange.RowCount >= 5) Then
                p.ID = Selection.Cells(4, 1).Value          '慣性座標系基準点識別
                p.t = Selection.Cells(5, 1).Value           '慣性基準設定から発射までの時間
            Else
                p.ID = 0
                p.t = 0#
            End If
            GetInertialFrame = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 3) Then
            p.Y0Day.Yr = Year(Selection.Cells(1, 1).Value)
            p.Y0Day.Mn = Month(Selection.Cells(1, 1).Value)
            p.Y0Day.Dy = day(Selection.Cells(1, 1).Value)
            p.Xtime.hr = Hour(Selection.Cells(1, 2).Value)
            p.Xtime.min = Minute(Selection.Cells(1, 2).Value)
            p.Xtime.sec = Second(Selection.Cells(1, 2).Value) + Selection.Cells(1, 3).Value
            If (TargetRange.ColumnCount >= 5) Then
                p.ID = Selection.Cells(1, 4).Value
                p.t = Selection.Cells(1, 5).Value
            Else
                p.ID = 0
                p.t = 0#
            End If
            GetInertialFrame = True
        Else
            GetInertialFrame = False
        End If
    Else
        GetInertialFrame = False
    End If
    If (GetInertialFrame) Then
        fmOntime = p.Xtime
        fmOntime.sec = fmOntime.sec - p.t
        p.Glng = GrnLng(p.Y0Day, fmOntime)  '春分点からグリニッジまでの経度
        Select Case p.ID                    'グリニッジから慣性基準点までの経度の設定
        Case 0                                  '射点子午面基準（航法座標系）
            p.Ilng = Cpad.lng - WEERD * p.t
        Case 1                                  'グリニッジ子午面基準
            p.Ilng = 0#
        Case 2                                  '春分点基準
            p.Ilng = -p.Glng
        Case Else
        End Select
    Else
        MsgBox "慣性座標系規定データの選択範囲が不正です。"
    End If

End Function
Function GetMatrix3x3(m As Matrix3x3, TargetRange As CellRange) As Boolean

'マトリクス（３ｘ３）をシートから取得する

' m          ：出力、マトリクス（３ｘ３）データ
' TargetRange：入力、セル範囲

    Dim d() As Variant

    GetMatrix3x3 = GetArray(d, TargetRange)
    If (GetMatrix3x3) Then
        If (UBound(d) = 9) Then
            m.x.x = d(1)
            m.x.y = d(2)
            m.x.z = d(3)
            m.y.x = d(4)
            m.y.y = d(5)
            m.y.z = d(6)
            m.z.x = d(7)
            m.z.y = d(8)
            m.z.z = d(9)
        Else
            GetMatrix3x3 = False
        End If
    End If
    If (Not GetMatrix3x3) Then
        MsgBox "マトリクス（３ｘ３）の選択範囲が不正です。"
    End If

End Function
Function GetMatrix3x3Range(m As Matrix3x3, r As Range) As Boolean

'関数引数で範囲指定されたマトリクス（３ｘ３）をシートから取得する

' m      ：出力、マトリクス（３ｘ３）データ
' r      ：入力、セル範囲

    Dim d() As Variant

    GetMatrix3x3Range = GetArrayRange(d, r)
    If (GetMatrix3x3Range) Then
        If (UBound(d) = 9) Then
            m.x.x = d(1)
            m.x.y = d(2)
            m.x.z = d(3)
            m.y.x = d(4)
            m.y.y = d(5)
            m.y.z = d(6)
            m.z.x = d(7)
            m.z.y = d(8)
            m.z.z = d(9)
        Else
            GetMatrix3x3Range = False
        End If
    End If
    If (Not GetMatrix3x3Range) Then
        MsgBox "マトリクス（３ｘ３）の選択範囲が不正です。"
    End If

End Function
Function GetOrbitalElements(O As OrbitalElements, TargetRange As CellRange) As Boolean

'軌道要素をシートから取得する

' O          ：出力、軌道要素
' TargetRange：入力、セル範囲

    Dim mInv As Double, e1p As Double, e1m As Double
    Dim apg As Double, prg As Double, ant As Double

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 6 And TargetRange.ColumnCount = 1) Then
            O.a = Selection.Cells(1, 1).Value           '軌道長半径（m）
            O.ecc = Selection.Cells(2, 1).Value         '離心率
            O.ainc = Selection.Cells(3, 1).Value        '軌道傾斜角（deg）
            O.asnd = Selection.Cells(4, 1).Value        '昇降点経度（deg）
            O.argp = Selection.Cells(5, 1).Value        '近地点引数（deg）
            O.argl = Selection.Cells(6, 1).Value        '緯度引数（deg）
            If (TargetRange.RowCount >= 10) Then
                O.apf = Selection.Cells(7, 1).Value     '遠地点高度（m）
                O.prf = Selection.Cells(8, 1).Value     '近地点高度（m）
                O.Raan = Selection.Cells(9, 1).Value    '昇降点赤経（deg）
                O.ant = Selection.Cells(10, 1).Value    '真近点離角（deg）
            Else
                O.apf = vbNull
            End If
            If (TargetRange.RowCount >= 19) Then
                O.ane = Selection.Cells(11, 1).Value    '離心近点離角（deg）
                O.anm = Selection.Cells(12, 1).Value    '平均近点離角（deg）
                O.apg = Selection.Cells(13, 1).Value    '遠地点半径（m）
                O.prg = Selection.Cells(14, 1).Value    '近地点半径（m）
                O.vapf = Selection.Cells(15, 1).Value   '遠地点速度（m/s）
                O.vprf = Selection.Cells(16, 1).Value   '近地点速度（m/s）
                O.envv = Selection.Cells(17, 1).Value   '軌道エネルギー（m^2/s^2）
                O.perd = Selection.Cells(18, 1).Value   '周期（s）
                O.p = Selection.Cells(19, 1).Value      '半通径（m）
            Else
                O.ane = vbNull
            End If
            GetOrbitalElements = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 6) Then
            O.a = Selection.Cells(1, 1).Value           '軌道長半径（m）
            O.ecc = Selection.Cells(1, 2).Value         '離心率
            O.ainc = Selection.Cells(1, 3).Value        '軌道傾斜角（deg）
            O.asnd = Selection.Cells(1, 4).Value        '昇降点経度（deg）
            O.argp = Selection.Cells(1, 5).Value        '近地点引数（deg）
            O.argl = Selection.Cells(1, 6).Value        '緯度引数（deg）
            If (TargetRange.ColumnCount >= 10) Then
                O.apf = Selection.Cells(1, 7).Value     '遠地点高度（m）
                O.prf = Selection.Cells(1, 8).Value     '近地点高度（m）
                O.Raan = Selection.Cells(1, 9).Value    '昇降点赤経（deg）
                O.ant = Selection.Cells(10, 10).Value   '真近点離角（deg）
            Else
                O.apf = vbNull
            End If
            If (TargetRange.ColumnCount >= 19) Then
                O.ane = Selection.Cells(1, 11).Value    '離心近点離角（deg）
                O.anm = Selection.Cells(1, 12).Value    '平均近点離角（deg）
                O.apg = Selection.Cells(1, 13).Value    '遠地点半径（m）
                O.prg = Selection.Cells(1, 14).Value    '近地点半径（m）
                O.vapf = Selection.Cells(1, 15).Value   '遠地点速度（m/s）
                O.vprf = Selection.Cells(1, 16).Value   '近地点速度（m/s）
                O.envv = Selection.Cells(1, 17).Value   '軌道エネルギー（m^2/s^2）
                O.perd = Selection.Cells(1, 18).Value   '周期（s）
                O.p = Selection.Cells(1, 19).Value      '半通径（m）
            Else
                O.ane = vbNull
            End If
            GetOrbitalElements = True
        Else
            GetOrbitalElements = False
        End If
    Else
        GetOrbitalElements = False
    End If
    If (GetOrbitalElements) Then
        If (O.apf = vbNull) Then
            mInv = GMER / O.a
            e1p = (1# + O.ecc)
            e1m = (1# - O.ecc)
            apg = O.a * e1p
            prg = O.a * e1m
            O.apf = apg - ARER                          '遠地点高度（m）
            O.prf = prg - ARER                          '近地点高度（m）
            O.Raan = INCO.Glng + O.asnd                 '昇降点赤経（deg）
            O.Raan = O.Raan - CDbl(Int(O.Raan / 360#)) * 360#
            O.ant = O.argl - O.argp                     '真近点離角（deg）
            O.ant = O.ant - CDbl(Int(O.ant / 360#)) * 360#
        End If
        If (O.ane = vbNull) Then
            O.p = O.a * (1# - O.ecc ^ 2)                '半通径（m）
            ant = O.ant * CRDDG
            O.ane = Actand(Sqr((1# - O.ecc ^ 2)) * Sin(ant) _
                    , O.ecc + Cos(ant))                 '離心近点離角（deg）
            O.anm = O.ane - O.ecc * Sin(O.ane * CRDDG) * CDGRD '平均近点離角（deg）
            O.anm = O.anm - CDbl(Int(O.anm / 360#)) * 360#
            O.apg = apg                                 '遠地点半径（m）
            O.prg = prg                                 '近地点半径（m）
            O.vapf = Sqr(mInv * e1m / e1p)              '遠地点速度（m/s）
            O.vprf = Sqr(mInv * e1p / e1m)              '近地点速度（m/s）
            O.envv = -mInv / 2#                         '軌道エネルギー（m^2/s^2）
            O.perd = TOPI * Sqr(O.a ^ 2 / mInv)         '周期（s）
        End If
    Else
        MsgBox "軌道要素の選択範囲が不正です。"
    End If

End Function
Function GetQuaternion(q As Quaternion, TargetRange As CellRange) As Boolean

'四元数をシートから取得する

' q          ：出力、四元数
' TargetRange：入力、セル範囲

    Dim d() As Variant

    GetQuaternion = GetArray(d, TargetRange)
    If (GetQuaternion) Then
        If (UBound(d) = 4) Then
            q.c = d(1)
            q.s.x = d(2)
            q.s.y = d(3)
            q.s.z = d(4)
        Else
            GetQuaternion = False
        End If
    End If
    If (Not GetQuaternion) Then
        MsgBox "四元数の選択範囲が不正です。"
    End If

End Function
Function GetQuaternionRange(q As Quaternion, r As Range) As Boolean

'関数引数で範囲指定された四元数をシートから取得する

' q      ：出力、四元数
' r      ：入力、セル範囲

    Dim d() As Variant

    GetQuaternionRange = GetArrayRange(d, r)
    If (GetQuaternionRange) Then
        If (UBound(d) = 4) Then
            q.c = d(1)
            q.s.x = d(2)
            q.s.y = d(3)
            q.s.z = d(4)
        Else
            GetQuaternionRange = False
        End If
    End If
    If (Not GetQuaternionRange) Then
        MsgBox "四元数の選択範囲が不正です。"
    End If

End Function
Function GetSiteLocation(p As SiteLocation, TargetRange As CellRange) As Boolean

'地上局位置データをシートから取得する

' p          ：出力、地上局位置データ
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 3 And TargetRange.ColumnCount = 1) Then
            p.alt = Selection.Cells(1, 1).Value     '高度（m）
            p.Ltg = Selection.Cells(2, 1).Value     '測地緯度（deg）
            p.lng = Selection.Cells(3, 1).Value     '経度（deg）
            If (TargetRange.RowCount >= 4) Then
                p.Azl = Selection.Cells(4, 1).Value '局設置方位角（deg）
            Else
                p.Azl = 0#
            End If
            If (TargetRange.RowCount >= 7) Then
                p.lat = Selection.Cells(5, 1).Value '天文緯度（deg）
                p.Gsp = Selection.Cells(6, 1).Value 'ジオイドのずれ（m）
                p.Def = Selection.Cells(7, 1).Value '東西方向の鉛直からの傾き（deg）
            Else
                p.lat = p.Ltg
                p.Gsp = 0#
                p.Def = 0#
            End If
            GetSiteLocation = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 3) Then
            p.alt = Selection.Cells(1, 1).Value     '高度（m）
            p.Ltg = Selection.Cells(1, 2).Value     '測地緯度（deg）
            p.lng = Selection.Cells(1, 3).Value     '経度（deg）
            If (TargetRange.ColumnCount >= 4) Then
                p.Azl = Selection.Cells(1, 4).Value '局設置方位角（deg）
            Else
                p.Azl = 0#
            End If
            If (TargetRange.ColumnCount >= 7) Then
                p.lat = Selection.Cells(1, 5).Value '天文緯度（deg）
                p.Gsp = Selection.Cells(1, 6).Value 'ジオイドのずれ（m）
                p.Def = Selection.Cells(1, 7).Value '東西方向の鉛直からの傾き（deg）
            Else
                p.lat = p.Ltg
                p.Gsp = 0#
                p.Def = 0#
            End If
            GetSiteLocation = True
        Else
            GetSiteLocation = False
        End If
    Else
        GetSiteLocation = False
    End If
    If (Not GetSiteLocation) Then
        MsgBox "地上局位置データの選択範囲が不正です。"
    End If

End Function
Function GetTable(F As Table, TargetRange As CellRange) As Boolean

'汎用テーブルデータをシートから取得する

' F          ：出力、汎用テーブルデータ
' TargetRange：入力、セル範囲

    Dim i As Integer, j As Integer

    If (TargetRange.Row > 0 And TargetRange.Column > 0 _
                            And TargetRange.RowCount > 9) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        F.Fnam = Selection.Cells(1, 1).Value        '関数名
        F.Anam = Selection.Cells(2, 1).Value        '引数名
        F.Nf = Selection.Cells(3, 1).Value          '関数の数
        F.Intp = Selection.Cells(4, 1).Value        '補間方法、"ステップ" or "１次"
        F.fEnd = Selection.Cells(5, 1).Value        'テーブル前端点の処理、"ゼロ" or "一定" or "１次"
        F.bEnd = Selection.Cells(6, 1).Value        'テーブル後端点の処理、"ゼロ" or "一定" or "１次"
        F.cInt = Selection.Cells(7, 1).Value        '節点処理、"積分" or "補間"
        ReDim F.Mlt(0 To F.Nf)
        ReDim F.Add(0 To F.Nf)
        For i = 0 To F.Nf
            F.Mlt(i) = Selection.Cells(8, 1 + i).Value '引数及び関数の乗数
            F.Add(i) = Selection.Cells(9, 1 + i).Value '引数及び関数の加数
        Next i
        F.nD = TargetRange.RowCount - 9             'データ数（引数データの個数）
        ReDim F.Val(1 To F.Nf)                      '関数値
        ReDim F.Data(1 To F.nD, 0 To F.Nf)          'データ
        For j = 0 To F.Nf
            For i = 1 To F.nD
                F.Data(i, j) = Selection.Cells(i + 9, 1 + j).Value
            Next i
        Next j
        For j = 1 To F.Nf
            F.Val(j) = 0#
        Next j
        If (F.nD <= 1) Then
            If (F.Intp <> "ステップ") Then F.Intp = "ステップ"
            If (F.fEnd <> "ゼロ" And F.fEnd <> "一定") Then F.fEnd = "一定"
            If (F.bEnd <> "ゼロ" And F.bEnd <> "一定") Then F.bEnd = "一定"
        End If
        F.arg = vbInf
        F.ix = 0
        F.ixp = -1
        F.jDis = 0
        F.arg = vbInf
        F.slp = 1#
        F.slpT = vbTmax
        F.slpArg = vbInf
        F.aDis = vbInf
        F.tDis = vbTmax
        GetTable = True
    Else
        GetTable = False
    End If

End Function
Function GetTargetRange(MsgText As String) As Boolean

'演算対象セルの選択範囲を取得する（セル範囲をマニュアル設定する場合に使用）。

' MsgText : 入力、メッセージボックスに表示する文字列

    Dim InpRow As Long, InpCol As Long
    Dim WatchDogTimer
    Const WaitTime = 15                  'セル選択の待ち時間（秒）

    '不用意なイベントが貯まっていたら、それを発生させる（有り得ないかも？）
    Application.EnableEvents = True
    DoEvents

    'メッセージを表示し、初期設定する
    If (MsgText <> "") Then MsgBox MsgText
    WatchDogTimer = Timer + WaitTime    'ウォッチドッグタイマの設定
    TargetRange.Row = 0                 'タイムアウトの場合、目的外のセルを
    TargetRange.Column = 0              '  書き換えないようにする
    TargetRange.RowCount = 0
    TargetRange.ColumnCount = 0
    InpRow = TargetRange.Row
    InpCol = TargetRange.Column
    GetTargetRange = True

    'セルが選択されるまで待つ。
    Do While ((InpRow = TargetRange.Row) And (InpCol = TargetRange.Column))
        Application.EnableEvents = True
        DoEvents
        If (WatchDogTimer < Timer) Then
            '所定の時間経過してもセルが選択されなかった。
            If (MsgBox("セルの選択が認識できませんでした。" & vbCrLf _
                & "前と同じ選択済みのセルで実行しますか？", vbOKCancel) = vbOK) Then
                Exit Do
            Else
                GetTargetRange = False
                MsgBox "選択し直して続行するか、マクロ編集画面で停止してください。"
                WatchDogTimer = Timer + WaitTime * 4
            End If
        End If
    Loop

    'イベントの発生を禁止する
    Application.EnableEvents = False

End Function
Function GetTrajectoryStateVariables(F As StateVariables, TargetRange As CellRange) As Boolean

'飛行状態量をシートから取得する

' F          ：出力、飛行状態量
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 6 And TargetRange.ColumnCount = 1) Then
            F.r.x = Selection.Cells(1, 1).Value             '地心半径ベクトル
            F.r.y = Selection.Cells(2, 1).Value
            F.r.z = Selection.Cells(3, 1).Value
            F.v.x = Selection.Cells(4, 1).Value             '慣性速度ベクトル
            F.v.y = Selection.Cells(5, 1).Value
            F.v.z = Selection.Cells(6, 1).Value
            If (TargetRange.RowCount >= 10) Then
                F.qIB.c = Selection.Cells(7, 1).Value       '四元数
                F.qIB.s.x = Selection.Cells(8, 1).Value
                F.qIB.s.y = Selection.Cells(9, 1).Value
                F.qIB.s.z = Selection.Cells(10, 1).Value
            Else
                F.qIB.c = vbNull
            End If
            If (TargetRange.RowCount >= 19) Then
                F.Dibm.x.x = Selection.Cells(11, 1).Value   '方向余弦マトリクス
                F.Dibm.x.y = Selection.Cells(12, 1).Value
                F.Dibm.x.z = Selection.Cells(13, 1).Value
                F.Dibm.y.x = Selection.Cells(14, 1).Value
                F.Dibm.y.y = Selection.Cells(15, 1).Value
                F.Dibm.y.z = Selection.Cells(16, 1).Value
                F.Dibm.z.x = Selection.Cells(17, 1).Value
                F.Dibm.z.y = Selection.Cells(18, 1).Value
                F.Dibm.z.z = Selection.Cells(19, 1).Value
            Else
                F.Dibm.x.x = vbNull
            End If
            GetTrajectoryStateVariables = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 6) Then
            F.r.x = Selection.Cells(1, 1).Value             '地心半径
            F.r.y = Selection.Cells(1, 2).Value
            F.r.z = Selection.Cells(1, 3).Value
            F.v.x = Selection.Cells(1, 4).Value             '慣性速度
            F.v.y = Selection.Cells(1, 5).Value
            F.v.z = Selection.Cells(1, 6).Value
            If (TargetRange.ColumnCount >= 10) Then
                F.qIB.c = Selection.Cells(1, 7).Value       '四元数
                F.qIB.s.x = Selection.Cells(1, 8).Value
                F.qIB.s.y = Selection.Cells(1, 9).Value
                F.qIB.s.z = Selection.Cells(1, 10).Value
            Else
                F.qIB.c = vbNull
            End If
            If (TargetRange.ColumnCount >= 19) Then
                F.Dibm.x.x = Selection.Cells(1, 11).Value   '方向余弦マトリクス
                F.Dibm.x.y = Selection.Cells(1, 12).Value
                F.Dibm.x.z = Selection.Cells(1, 13).Value
                F.Dibm.y.x = Selection.Cells(1, 14).Value
                F.Dibm.y.y = Selection.Cells(1, 15).Value
                F.Dibm.y.z = Selection.Cells(1, 16).Value
                F.Dibm.z.x = Selection.Cells(1, 17).Value
                F.Dibm.z.y = Selection.Cells(1, 18).Value
                F.Dibm.z.z = Selection.Cells(1, 19).Value
            Else
                F.Dibm.x.x = vbNull
            End If
            GetTrajectoryStateVariables = True
        Else
            GetTrajectoryStateVariables = False
        End If
    Else
        GetTrajectoryStateVariables = False
    End If
    If (GetTrajectoryStateVariables) Then
        If (F.qIB.c = vbNull) Then
            F.qIB.c = 1#
            F.qIB.s.x = 0#
            F.qIB.s.y = 0#
            F.qIB.s.z = 0#
        End If
        If (F.Dibm.x.x = vbNull) Then
            F.Dibm = QtnDcm(F.qIB)
        End If
    Else
        MsgBox "選択範囲が不正です。" & vbCrLf _
             & "(位置,速度,[四元数],[方向余弦マトリクス])の６or１０or１９個"
    End If

End Function
Function GetVariant(v As Variant, TargetRange As CellRange) As Boolean

'任意型のデータをシートから取得する

' V          ：出力、任意型データ
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (Selection.Cells(1, 1).Value = "") Then
            v = 0#
        Else
            v = Selection.Cells(1, 1).Value
        End If
        GetVariant = True
    Else
        GetVariant = False
    End If

End Function
Function GetVariantRange(v As Variant, r As Range) As Boolean

'関数引数で範囲指定された任意型のデータをシートから取得する

' V      ：出力、任意型データ
' r      ：入力、セル範囲

    If (r.Rows.Count = 1 And r.Columns.Count = 1) Then
        v = r.Cells(1, 1).Value
        GetVariantRange = True
    Else
        GetVariantRange = False
    End If

End Function
Function GetVector3D(v As Vector3D, TargetRange As CellRange) As Boolean

'３次元ベクトルをシートから取得する

' V          ：出力、３次元ベクトル
' TargetRange：入力、セル範囲

    Dim d() As Variant

    GetVector3D = GetArray(d, TargetRange)
    If (GetVector3D) Then
        If (UBound(d) = 3) Then
            v.x = d(1)
            v.y = d(2)
            v.z = d(3)
        Else
            GetVector3D = False
        End If
    End If
    If (Not GetVector3D) Then
        MsgBox "３次元ベクトルの選択範囲が不正です。"
    End If

End Function
Function GetVectorND(v As VectorND, TargetRange As CellRange) As Boolean

'Ｎ次元ベクトルをシートから取得する

' V          ：出力、Ｎ次元ベクトル
' TargetRange：入力、セル範囲

    Dim d() As Variant

    GetVectorND = GetArray(d, TargetRange)
    If (GetVectorND) Then
        For i = 1 To UBound(d)
            v(i) = d(i)
        Next
    Else
        MsgBox "Ｎ次元ベクトルの選択範囲が不正です。"
    End If

End Function
Function GetVector3DRange(v As Vector3D, r As Range) As Boolean

'関数引数で範囲指定された３次元ベクトルをシートから取得する

' V      ：出力、３次元ベクトル
' r      ：入力、セル範囲

    Dim d() As Variant

    GetVector3DRange = GetArrayRange(d, r)
    If (GetVector3DRange) Then
        If (UBound(d) = 3) Then
            v.x = d(1)
            v.y = d(2)
            v.z = d(3)
        Else
            GetVector3DRange = False
        End If
    End If
    If (Not GetVector3DRange) Then
        MsgBox "３次元ベクトルの選択範囲が不正です。"
    End If

End Function
Function GetVectorNDRange(v As VectorND, r As Range) As Boolean

'関数引数で範囲指定されたＮ次元ベクトルをシートから取得する

' V      ：出力、Ｎ次元ベクトル
' r      ：入力、セル範囲

    Dim d() As Variant

    GetVectorNDRange = GetArrayRange(d, r)
    If (GetVectorNDRange) Then
        For i = 1 To UBound(d)
            v(i) = d(i)
        Next
    Else
        MsgBox "Ｎ次元ベクトルの選択範囲が不正です。"
    End If

End Function
Function PutArray(a() As Variant, TargetRange As CellRange) As Boolean

'任意型の配列データをシートに設定する
'　（シートの行方向から先に設定する）

' a()        ：入力、任意型配列データ
' TargetRange：入力、セル範囲

    Dim i As Long, j As Long, k As Long, n As Long
    Dim nR As Long, nC As Long

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        n = UBound(a)
        nC = TargetRange.ColumnCount
        nR = n / nC
        k = 0
        For j = 1 To nC
            For i = 1 To nR
                k = k + 1
                Selection.Cells(i, j).Value = a(k)
                If (k >= n) Then Exit For
            Next i
            If (k >= n) Then Exit For
        Next j
        If (k = n) Then
            PutArray = True
        Else
            PutArray = False
        End If
    Else
        PutArray = False
    End If

End Function
Function PutDblArray(a() As Double, TargetRange As CellRange) As Boolean

'倍精度型の配列データをシートに設定する
'　（シートの行方向から先に設定する）

' a()        ：入力、倍精度型配列データ
' TargetRange：入力、セル範囲

    Dim i As Long, j As Long, k As Long, n As Long
    Dim nR As Long, nC As Long

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        n = UBound(a)
        nC = TargetRange.ColumnCount
        nR = n / nC
        k = 0
        For j = 1 To nC
            For i = 1 To nR
                k = k + 1
                Selection.Cells(i, j).Value = a(k)
                If (k >= n) Then Exit For
            Next i
            If (k >= n) Then Exit For
        Next j
        If (k = n) Then
            PutDblArray = True
        Else
            PutDblArray = False
        End If
    Else
        PutDblArray = False
    End If

End Function
Function PutArrayRange(a() As Variant, r As Range) As Boolean

'関数引数で範囲指定された任意の型の配列データをシートに設定する
'　（シートの行方向から先に設定する）

' a()    ：入力、任意型配列データ
' r      ：入力、セル範囲

    Dim i As Long, j As Long, k As Long, n As Long
    Dim nR As Long, nC As Long
    
    If (r.Row > 0 And r.Column > 0) Then
        n = UBound(a)
        nC = r.Columns.Count
        nR = r.Rows.Count
        k = 0
        For j = 1 To nC
            For i = 1 To nR
                k = k + 1
                 r.Cells(i, j).Value = a(k)
                 If (k >= n) Then Exit For
            Next i
            If (k >= n) Then Exit For
        Next j
        If (k = n) Then
            PutArrayRange = True
        Else
            PutArrayRange = False
        End If
    Else
        PutArrayRange = False
    End If

End Function
Function PutGeoGraphicQuantities(g As GeoGraphicQuantities, TargetRange As CellRange) As Boolean

'地理関連諸量をシートに設定する

' G          ：入力、地理関連諸量
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 6 And TargetRange.ColumnCount = 1) Then
            Selection.Cells(1, 1).Value = g.ri          '地心半径
            Selection.Cells(2, 1).Value = g.Vltc        '地心緯度
            Selection.Cells(3, 1).Value = g.Vlni        '慣性座標Ｘ軸からの経度
            Selection.Cells(4, 1).Value = g.alt         '高度
            Selection.Cells(5, 1).Value = g.Vlat        '測地緯度
            Selection.Cells(6, 1).Value = g.Vlng        '経度
            If (TargetRange.RowCount >= 9) Then
                Selection.Cells(7, 1).Value = g.Vi      '慣性速度
                Selection.Cells(8, 1).Value = g.Fpvi    '慣性速度上下角
                Selection.Cells(9, 1).Value = g.Azvi    '慣性速度方位角
            End If
            If (TargetRange.RowCount >= 12) Then
                Selection.Cells(10, 1).Value = g.Atli   '機軸上下角
                Selection.Cells(11, 1).Value = g.Amis   '機軸方位角
                Selection.Cells(12, 1).Value = g.Rlat   'バンク角
            End If
            PutGeoGraphicQuantities = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 6) Then
            Selection.Cells(1, 1).Value = g.ri
            Selection.Cells(1, 2).Value = g.Vltc
            Selection.Cells(1, 3).Value = g.Vlni
            Selection.Cells(1, 4).Value = g.alt
            Selection.Cells(1, 5).Value = g.Vlat
            Selection.Cells(1, 6).Value = g.Vlng
            If (TargetRange.ColumnCount >= 9) Then
                Selection.Cells(1, 7).Value = g.Vi
                Selection.Cells(1, 8).Value = g.Fpvi
                Selection.Cells(1, 9).Value = g.Azvi
            End If
            If (TargetRange.ColumnCount >= 12) Then
                Selection.Cells(1, 10).Value = g.Atli
                Selection.Cells(1, 11).Value = g.Amis
                Selection.Cells(1, 12).Value = g.Rlat
            End If
            PutGeoGraphicQuantities = True
        Else
            PutGeoGraphicQuantities = False
        End If
    Else
        PutGeoGraphicQuantities = False
    End If
    If (Not PutGeoGraphicQuantities) Then
        MsgBox "選択範囲が不正です。" & vbCrLf _
             & "(位置関連,[速度関連],[姿勢関連])の６or９or１２個"
    End If

End Function
Function PutMatrix3x3(m As Matrix3x3, TargetRange As CellRange) As Boolean

'マトリクス（３ｘ３）をシートに設定する

' m          ：入力、マトリクス（３ｘ３）データ
' TargetRange：入力、セル範囲

    Dim d(9) As Variant

    If (TargetRange.RowCount * TargetRange.ColumnCount = 9) Then
        d(1) = m.x.x
        d(2) = m.x.y
        d(3) = m.x.z
        d(4) = m.y.x
        d(5) = m.y.y
        d(6) = m.y.z
        d(7) = m.z.x
        d(8) = m.z.y
        d(9) = m.z.z
        PutMatrix3x3 = PutArray(d, TargetRange)
    Else
        PutMatrix3x3 = False
    End If
    If (Not PutMatrix3x3) Then
        MsgBox "マトリクス（３ｘ３）の選択範囲が不正です。"
    End If

End Function
Function PutOrbitalElements(O As OrbitalElements, TargetRange As CellRange) As Boolean

'軌道要素をシートに設定する

' O          ：入力、軌道要素
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 6 And TargetRange.ColumnCount = 1) Then
            Selection.Cells(1, 1).Value = O.a           '軌道長半径（m）
            Selection.Cells(2, 1).Value = O.ecc         '離心率
            Selection.Cells(3, 1).Value = O.ainc        '軌道傾斜角（deg）
            Selection.Cells(4, 1).Value = O.asnd        '昇降点経度（deg）
            Selection.Cells(5, 1).Value = O.argp        '近地点引数（deg）
            Selection.Cells(6, 1).Value = O.argl        '緯度引数（deg）
            If (TargetRange.RowCount >= 10) Then
                Selection.Cells(7, 1).Value = O.apf     '遠地点高度（m）
                Selection.Cells(8, 1).Value = O.prf     '近地点高度（m）
                Selection.Cells(9, 1).Value = O.Raan    '昇降点赤経（deg）
                Selection.Cells(10, 1).Value = O.ant    '真近点離角（deg）
            End If
            If (TargetRange.RowCount >= 19) Then
                Selection.Cells(11, 1).Value = O.ane    '離心近点離角（deg）
                Selection.Cells(12, 1).Value = O.anm    '平均近点離角（deg）
                Selection.Cells(13, 1).Value = O.apg    '遠地点半径（m）
                Selection.Cells(14, 1).Value = O.prg    '近地点半径（m）
                Selection.Cells(15, 1).Value = O.vapf   '遠地点速度（m/s）
                Selection.Cells(16, 1).Value = O.vprf   '近地点速度（m/s）
                Selection.Cells(17, 1).Value = O.envv   '軌道エネルギー（m^2/s^2）
                Selection.Cells(18, 1).Value = O.perd   '周期（s）
                Selection.Cells(19, 1).Value = O.p      '半通径（m）
            End If
            PutOrbitalElements = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 6) Then
            Selection.Cells(1, 1).Value = O.a           '軌道長半径（m）
            Selection.Cells(1, 2).Value = O.ecc         '離心率
            Selection.Cells(1, 3).Value = O.ainc        '軌道傾斜角（deg）
            Selection.Cells(1, 4).Value = O.asnd        '昇降点経度（deg）
            Selection.Cells(1, 5).Value = O.argp        '近地点引数（deg）
            Selection.Cells(1, 6).Value = O.argl        '緯度引数（deg）
            If (TargetRange.ColumnCount >= 10) Then
                Selection.Cells(1, 7).Value = O.apf     '遠地点高度（m）
                Selection.Cells(1, 8).Value = O.prf     '近地点高度（m）
                Selection.Cells(1, 9).Value = O.Raan    '昇降点赤経（deg）
                Selection.Cells(1, 10).Value = O.ant    '真近点離角（deg）
            End If
            If (TargetRange.ColumnCount >= 19) Then
                Selection.Cells(1, 11).Value = O.ane    '離心近点離角（deg）
                Selection.Cells(1, 12).Value = O.anm    '平均近点離角（deg）
                Selection.Cells(1, 13).Value = O.apg    '遠地点半径（m）
                Selection.Cells(1, 14).Value = O.prg    '近地点半径（m）
                Selection.Cells(1, 15).Value = O.vapf   '遠地点速度（m/s）
                Selection.Cells(1, 16).Value = O.vprf   '近地点速度（m/s）
                Selection.Cells(1, 17).Value = O.envv   '軌道エネルギー（m^2/s^2）
                Selection.Cells(1, 18).Value = O.perd   '周期（s）
                Selection.Cells(1, 19).Value = O.p      '半通径（m）
            End If
            PutOrbitalElements = True
        Else
            PutOrbitalElements = False
        End If
    Else
        PutOrbitalElements = False
    End If
    If (Not PutOrbitalElements) Then
        MsgBox "軌道要素の選択範囲が不正です。"
    End If

End Function
Function PutQuaternion(q As Quaternion, TargetRange As CellRange) As Boolean

'四元数をシートに設定する

' q          ：入力、四元数
' TargetRange：入力、セル範囲

    Dim d(4) As Variant

    If (TargetRange.RowCount * TargetRange.ColumnCount = 4) Then
        d(1) = q.c
        d(2) = q.s.x
        d(3) = q.s.y
        d(4) = q.s.z
        PutQuaternion = PutArray(d, TargetRange)
    Else
        PutQuaternion = False
    End If
    If (Not PutQuaternion) Then
        MsgBox "四元数の選択範囲が不正です。"
    End If

End Function
Function PutViewQuantities(q As ViewQuantities, TargetRange As CellRange) As Boolean

'視野情報をシートに設定する

' q          ：入力、視野情報
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 5 And TargetRange.ColumnCount = 1) Then
            Selection.Cells(1, 1).Value = q.Rg          '直距離
            Selection.Cells(2, 1).Value = q.Az          '方位角
            Selection.Cells(3, 1).Value = q.El          '上下角
            Selection.Cells(4, 1).Value = q.Tla         'トータルルックアングル
            Selection.Cells(5, 1).Value = q.Rla         'ロールルックアングル
            If (TargetRange.RowCount >= 8) Then
                Selection.Cells(6, 1).Value = q.r.x     '地上局位置地心半径
                Selection.Cells(7, 1).Value = q.r.y
                Selection.Cells(8, 1).Value = q.r.z
            PutViewQuantities = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 5) Then
            Selection.Cells(1, 1).Value = q.Rg          '直距離
            Selection.Cells(1, 2).Value = q.Az          '方位角
            Selection.Cells(1, 3).Value = q.El          '上下角
            Selection.Cells(1, 4).Value = q.Tla         'トータルルックアングル
            Selection.Cells(1, 5).Value = q.Rla         'ロールルックアングル
            If (TargetRange.ColumnCount >= 8) Then
                Selection.Cells(1, 6).Value = q.r.x     '地上局位置地心半径
                Selection.Cells(1, 7).Value = q.r.y
                Selection.Cells(1, 8).Value = q.r.z
            PutViewQuantities = True
        Else
            PutViewQuantities = False
        End If
    Else
        PutViewQuantities = False
    End If
    If (Not PutViewQuantities) Then
        MsgBox "視野情報の選択範囲が不正です。"
    End If

End Function
Function PutTrajectoryStateVariables(F As StateVariables, TargetRange As CellRange) As Boolean

'飛行状態量をシートに設定する

' F          ：入力、飛行状態量
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        If (TargetRange.RowCount >= 6 And TargetRange.ColumnCount = 1) Then
            Selection.Cells(1, 1).Value = F.r.x             '地心半径ベクトル
            Selection.Cells(2, 1).Value = F.r.y
            Selection.Cells(3, 1).Value = F.r.z
            Selection.Cells(4, 1).Value = F.v.x             '慣性速度ベクトル
            Selection.Cells(5, 1).Value = F.v.y
            Selection.Cells(6, 1).Value = F.v.z
            If (TargetRange.RowCount >= 10) Then
                Selection.Cells(7, 1).Value = F.qIB.c       '四元数
                Selection.Cells(8, 1).Value = F.qIB.s.x
                Selection.Cells(9, 1).Value = F.qIB.s.y
                Selection.Cells(10, 1).Value = F.qIB.s.z
            End If
            If (TargetRange.RowCount >= 19) Then
                Selection.Cells(11, 1).Value = F.Dibm.x.x   '方向余弦マトリクス
                Selection.Cells(12, 1).Value = F.Dibm.x.y
                Selection.Cells(13, 1).Value = F.Dibm.x.z
                Selection.Cells(14, 1).Value = F.Dibm.y.x
                Selection.Cells(15, 1).Value = F.Dibm.y.y
                Selection.Cells(16, 1).Value = F.Dibm.y.z
                Selection.Cells(17, 1).Value = F.Dibm.z.x
                Selection.Cells(18, 1).Value = F.Dibm.z.y
                Selection.Cells(19, 1).Value = F.Dibm.z.z
            End If
            PutTrajectoryStateVariables = True
        ElseIf (TargetRange.RowCount = 1 And TargetRange.ColumnCount >= 6) Then
            Selection.Cells(1, 1).Value = F.r.x
            Selection.Cells(1, 2).Value = F.r.y
            Selection.Cells(1, 3).Value = F.r.z
            Selection.Cells(1, 4).Value = F.v.x
            Selection.Cells(1, 5).Value = F.v.y
            Selection.Cells(1, 6).Value = F.v.z
            If (TargetRange.ColumnCount >= 10) Then
                Selection.Cells(1, 7).Value = F.qIB.c
                Selection.Cells(1, 8).Value = F.qIB.s.x
                Selection.Cells(1, 9).Value = F.qIB.s.y
                Selection.Cells(1, 10).Value = F.qIB.s.z
            End If
            If (TargetRange.ColumnCount >= 19) Then
                Selection.Cells(1, 11).Value = F.Dibm.x.x
                Selection.Cells(1, 12).Value = F.Dibm.x.y
                Selection.Cells(1, 13).Value = F.Dibm.x.z
                Selection.Cells(1, 14).Value = F.Dibm.y.x
                Selection.Cells(1, 15).Value = F.Dibm.y.y
                Selection.Cells(1, 16).Value = F.Dibm.y.z
                Selection.Cells(1, 17).Value = F.Dibm.z.x
                Selection.Cells(1, 18).Value = F.Dibm.z.y
                Selection.Cells(1, 19).Value = F.Dibm.z.z
            End If
            PutTrajectoryStateVariables = True
        Else
            PutTrajectoryStateVariables = False
        End If
    Else
        PutTrajectoryStateVariables = False
    End If
    If (Not PutTrajectoryStateVariables) Then
        MsgBox "選択範囲が不正です。" & vbCrLf _
             & "(位置,速度,[四元数],[方向余弦マトリクス])の６or１０or１９個"
    End If

End Function
Function PutVariant(v As Variant, TargetRange As CellRange) As Boolean

'任意型のデータをシートに設定する

' V          ：入力、任意型データ
' TargetRange：入力、セル範囲

    If (TargetRange.Row > 0 And TargetRange.Column > 0) Then
        Range("A1").Cells(TargetRange.Row, TargetRange.Column).Select
        Selection.Cells(1, 1).Value = v
        PutVariant = True
    Else
        PutVariant = False
    End If

End Function
Function PutVector3D(v As Vector3D, TargetRange As CellRange) As Boolean

'３次元ベクトルをシートに設定する

' V          ：入力、３次元ベクトル
' TargetRange：入力、セル範囲

    Dim d(3) As Variant

    If (TargetRange.RowCount * TargetRange.ColumnCount = 3) Then
        d(1) = v.x
        d(2) = v.y
        d(3) = v.z
        PutVector3D = PutArray(d, TargetRange)
    Else
        PutVector3D = False
    End If
    If (Not PutVector3D) Then
        MsgBox "３次元ベクトルの選択範囲が不正です。"
    End If

End Function
Function RangeToCellRange(r As Range) As CellRange

'セル範囲指定データをRange型からCellRange型に変換する

' R                : 入力、セルの範囲(Range型)
' RangeToCellRange : 出力、セルの範囲(CellRange型)

    RangeToCellRange.Row = r.Row                    'セルの行番号
    RangeToCellRange.Column = r.Column              'セルの列番号
    RangeToCellRange.RowCount = r.Rows.Count        'セルの行数
    RangeToCellRange.ColumnCount = r.Columns.Count  'セルの列数

End Function
Function SelectTargetRange(Target As Range) As Boolean

'選択されているセル範囲を取得し、GetTargetRange関数に伝達する

' Target : 入力、セルの範囲

    TargetRange.Row = Target.Row                    '選択されているセルの行番号
    TargetRange.Column = Target.Column              '選択されているセルの列番号
    TargetRange.RowCount = Target.Rows.Count        '選択されているセルの行数
    TargetRange.ColumnCount = Target.Columns.Count  '選択されているセルの列数
    Application.EnableEvents = False                'イベント発生の禁止
    SelectTargetRange = True

End Function
