Attribute VB_Name = "Module2"
'******************************************************************************
'*                              インタープリタ                                *
'******************************************************************************
'
'コンフィギュレーション識別番号：Exe-Ver3.0
'  配布用に変更記録削除
'　2018/11/27　　原作者
'
'　下記のスクリプト実行制御関数［Exe］がセルから呼び出されると、スクリプト実行要求情報を
'　当該セルのシートオブジェクトに設定し、"式表題"を表示して終了する。
'       Exe                       ：スクリプト実行制御関数
'
'　この［Exe］関数の計算を切っ掛けとして、当該シートのイベント駆動関数［Worksheet_Calculate］
'　が起動されて下記のインタープリタ実行制御関数［Interpreter］が呼び出され、Exe関数の引数に
'　記述されている関数を実行する。
'       Interpreter               ：インタープリタ実行制御
'
'　上記のインタープリタ実行制御［Interpreter］において、マクロ型の場合は下記により実行する。
'       ExecuteMacro              ：マクロ実行制御関数
'
'　スクリプト解析段階の関数
'       ParserConstants           ：字句解析用定数の定義
'       ScriptFormalize           ：スクリプトを標準形式に変更する
'       ScriptParser              ：スクリプトの字句解析
'       ScriptAnalyzer            ：スクリプトの文解析
'       ScriptFunctionCall        ：関数呼出しの解析
'       ScriptExpressionSet       ：式集合の解析
'       ScriptExpression          ：式の解析
'       ScriptTerm                ：項の解析
'       ScriptFactor              ：要素
'       ScriptUnaryOperator       ：単項演算子
'       ScriptBinaryOperator      ：２項演算子
'       ScriptTerminator          ：終端記号
'       GetToken                  ：字句の取得
'       isCellAddress             ：字句（名前）がセル番地か否かの判定およびセルの行列番号への変換
'       isCellRange               ：字句（名前）がセル範囲か否かの判定およびセル範囲型への変換
'       isInRange                 ：セル範囲がシートのデータ領域範囲内か否かの判定
'       PopInst                   ：実行順序番号の取出し
'       PopToken                  ：字句の取出し
'       PopStack                  ：スタックからの取出し
'       PushInst                  ：実行順序番号の格納
'       PushToken                 ：字句の格納
'       PushStack                 ：スタックへの格納
'       SyntaxError               ：文法エラーの処理
'
'　スクリプト実行段階の関数
'       ExecuteScript             ：スクリプトの実行
'       ExecuteAsignOperator      ：代入演算子の実行
'       ExecuteUnaryOperator      ：単項演算子の実行
'       ExecuteBinaryOperator     ：２項演算子の実行
'       ExecuteFunction           ：関数の実行
'       PushArray                 ：任意型の配列データの格納
'       PushData                  ：任意型データの格納
'       PushDate                  ：日付型データの格納
'       PushDblArray              ：倍精度型の配列データの格納
'       PushGgq                   ：地理関連諸量型データの格納
'       PushIntArray              ：整数型の配列データの格納
'       PushMat                   ：３Ｘ３マトリクス型データの格納
'       PushOrb                   ：軌道要素型データの格納
'       PushQtn                   ：四元数型データの格納
'       PushTime                  ：時刻型データの格納
'       PushTsv                   ：飛行状態量型データの格納
'       PushSite                  ：地上局位置型データの格納
'       PushVct                   ：３次元ベクトル型データの格納
'       PushView                  ：視野情報型データの格納
'       PopArray                  ：任意型の配列データの取出し
'       PopData                   ：任意型データの取出し
'       PopDate                   ：日付型データの取出し
'       PopDblArray               ：倍精度型の配列データの取出し
'       PopGgq                    ：地理関連諸量型データの取出し
'       PopIntArray               ：整数型の配列データの取出し
'       PopMat                    ：３Ｘ３マトリクス型データの取出し
'       PopOrb                    ：軌道要素型データの取出し
'       PopQtn                    ：四元数型データの取出し
'       PopTime                   ：時刻型データの取出し
'       PopTsv                    ：飛行状態量型データの取出し
'       PopSite                   ：地上局位置型データの取出し
'       PopVct                    ：３次元ベクトル型データの取出し
'       PopView                   ：視野情報型データの取出し
'       StackError                ：実行時スタックエラーの処理
'       ExecutionError            ：実行時エラーの処理
'       ErrorMessage              ：エラーメッセージの設定処理

Option Explicit

'トークン（字句）
    Public Type Token
        String As String    '文字列
        Type As Integer     'タイプ
        Value As Variant    '値
        SeqNo As Long       '順序番号
    End Type

'字句解析要素
    Public Type TokenElement
        OpenBrace As String                     '開きカッコ
        CloseBrace As String                    '閉じカッコ
        Delimiter As String                     '区切り記号
        Operator As String                      '全演算子
        AsignOperator As String                 '代入演算子
        RelationalOperator As String            '論理演算子
        ComparativeOperator As String           '比較演算子
        ArithmeticOperator As String            '算術演算子
        UnaryOperator As String                 '単項演算子
        ExponentialOperator As String           '指数演算子
        ipOrderOfPriority As String             '全演算子の優先順位
        ipAsignOperator As String               '代入演算子の優先順位
        ipRelationalOperator As String          '論理演算子の優先順位
        ipComparativeOperator As String         '比較演算子の優先順位
        ipArithmeticOperator As String          '算術演算子の優先順位
        ipUnaryOperator As String               '単項演算子の優先順位
        ipExponentialOperator As String         '指数演算子の優先順位
        ipEndOfScript As Integer                'スクリプトの終了
        ipName As Integer                       '名前
        ipNumeric As Integer                    '数値
        ipString As Integer                     '文字列
        ipComment As Integer                    '注釈
        ipDot As Integer                        'ドット
        ipOpenBrace As Integer                  '開きカッコ
        ipCloseBrace As Integer                 '閉じカッコ
        ipOperator As Integer                   '演算子
        ipDelimiter As Integer                  '区切り記号
        ipIllegalToken As Integer               '不正トークン
        ipFunction As Integer                   '関数
        ipCellAddress As Integer                'セル番地（範囲）
        ipPriorityAsignOperator As Integer      '代入演算子の最後のコード番号
        ipPriorityUnaryOperator As Integer      '単項演算子の最初のコード番号
    End Type

'変数定義
    Public Lex As TokenElement                  '字句解析要素
    Public Script As String                     'スクリプト
    Public Tkn As Token                         'トークン（字句）
    Public TokenStack() As Token                'トークンスタック
    Public TokenCount As Long                   'トークンスタックの個数
    Public Inst() As Variant                    '命令スタック
    Public InstCount As Long                    '命令スタックの個数
    Public Stack() As Variant                   '汎用スタック
    Public StackCount As Long                   '汎用スタックの個数
    Public Dbg As String                        'デバッグフラグ、＝,関数名１,･･･,関数名ｎ,：指定した関数のデバッグ
    Public ErrLoc As Long                       'エラー発生番地
    Public CallerAddress As String              '関数定義セル番地
    Public DestinationAddress As String         '関数戻り値セル番地
    Public UsedRange As CellRange               '使用済みセルの範囲
    Public ScriptNo As Long                     'スクリプト順序番号
    Public InstLoc As Long                      'スクリプト実行番地
    Public PrevRequest As String                '前回の実行要求リスト
    Public Args() As CellRange                  'マクロ呼び出し時の引数リスト
    Public TimeAtLastExecution As Single        '前回の実行時刻（午前0時からの経過秒時）

Function Exe(ParamArray a()) As Variant

' スクリプト実行制御関数

    Dim CallerAddress As String                                     '関数定義セルの番地

    CallerAddress = ActiveSheet.Application.Caller.Address          '関数定義セル番地の設定
    If (ActiveSheet.Scripts.Count < 1) Then ActiveSheet.Scripts.Add '実行要求登録リストの確保
    

    '実行要求をリストに登録する
    If (Left(ActiveSheet.Range(CallerAddress).Formula, 5) = "=exe(") Then
        ActiveSheet.Scripts.Item(1).ScriptText = ActiveSheet.Scripts.Item(1).ScriptText & CallerAddress & ","
    End If

    Exe = a(0)
    Application.EnableEvents = True
    DoEvents

End Function
Sub Interpreter()

'インタープリタ実行制御

    Dim L As Boolean
    Dim LL As Boolean
    Dim c As String
    Dim cc As String
    Dim i As Integer
    Dim k As Integer
    Dim n As Integer
    Const TimeIntervalLimit As Single = 10#

    '字句解析用定数の定義
    LL = ParserConstants()

    On Error Resume Next

    '実行要求リストの編集（実行要求の重複を削除）
    'ActiveSheet.Cells(ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count, 1) = ActiveSheet.Scripts.Item(1).ScriptText    'デバッグ出力
    If ((ActiveSheet.Scripts.Item(1).ScriptText = PrevRequest) And ((Timer - TimeAtLastExecution) < TimeIntervalLimit)) Then
        ActiveSheet.Scripts.Item(1).ScriptText = ""    '実行要求が同じリストであれば、不安定な繰り返し状態と見なして削除
    ElseIf (PrevRequest <> "") Then
        cc = PrevRequest
        i = InStr(cc, ",")
        Do While (i > 0)
            c = Left(cc, i)         'PrevRequestからアドレスを１つ取り出し、ScriptTextに同じアドレスが有ったらそれを削除
            cc = Mid(cc, i + 1)
            k = InStr(ActiveSheet.Scripts.Item(1).ScriptText, c)
            If (k > 0) Then
                ActiveSheet.Scripts.Item(1).ScriptText = Left(ActiveSheet.Scripts.Item(1).ScriptText, k - 1) & _
                                                          Mid(ActiveSheet.Scripts.Item(1).ScriptText, k + i)
            End If
            i = InStr(cc, ",")
        Loop
    End If
    PrevRequest = ActiveSheet.Scripts.Item(1).ScriptText

    '実行要求リストの確認
    i = InStr(ActiveSheet.Scripts.Item(1).ScriptText, ",")
    Do While (i > 0)

        '実行要求リストから関数定義セル番地を取得
        CallerAddress = Left(ActiveSheet.Scripts.Item(1).ScriptText, i - 1)
        ActiveSheet.Scripts.Item(1).ScriptText = Mid(ActiveSheet.Scripts.Item(1).ScriptText, i + 1)

        'デバッグ指示の設定
        Dbg = ",,"              '字句解析のデバッグ指定（デバッグ出力したい関数名をカンマ区切りで並べる）
        ErrLoc = -1             'エラー発生番地のリセット

        'メッセージ表示領域（シート上のコメントとして表示）の設定
        If (ActiveSheet.Range(CallerAddress).Worksheet.Comments.Count > 0) Then
            ActiveSheet.Range(CallerAddress).Comment.Delete     '古いメッセージを削除
        End If
        ActiveSheet.Range(CallerAddress).AddComment             '関数定義セルにメッセージ表示領域（シート上のコメント）を付加
        ActiveSheet.Range(CallerAddress).Comment.Visible = True 'メッセージ表示領域（シート上のコメント）の可視設定

        'トークンスタックの初期化
        TokenCount = -1
        ReDim TokenStack(10)

        '命令スタックの初期化
        InstCount = -1
        ReDim Inst(10)

        '汎用スタックの初期化
        StackCount = -1
        ReDim Stack(10)

        '使用済みセルの範囲
        UsedRange.Row = ActiveSheet.UsedRange.Row
        UsedRange.RowCount = ActiveSheet.UsedRange.Rows.Count
        UsedRange.Column = ActiveSheet.UsedRange.Column
        UsedRange.ColumnCount = ActiveSheet.UsedRange.Columns.Count

        'スクリプトを取り出し、先頭が”＝”であれば、スクリプトを実行
        Script = ActiveSheet.Range(CallerAddress).Formula
        Tkn = GetToken()
        If (Tkn.String = "=") Then

            'スクリプトを標準形式に変更
            Script = ScriptFormalize(Script)

            'スクリプトの字句解析
            LL = ScriptParser

            'スクリプトスタックの反転
            n = Int(TokenCount / 2)
            For i = 0 To n
                k = TokenCount - i
                Tkn = TokenStack(i)
                TokenStack(i) = TokenStack(k)
                TokenStack(k) = Tkn
            Next i

            '番号付け
            For i = 0 To TokenCount
                TokenStack(i).SeqNo = i
            Next i

            'スクリプトの解釈実行
            If (TokenStack(TokenCount - 2).Type <> Lex.ipString) Then
                n = TokenCount  '関数型
                LL = ScriptAnalyzer     'スクリプトの解析
                TokenCount = n
                LL = ExecuteScript      'スクリプトの実行
            Else                'マクロ型
                LL = ExecuteMacro       'マクロの実行
            End If

            'デバッグ出力
            If (InStr(Dbg, ",Parser,") > 0 Or ErrLoc >= 0) Then

                '実行順序番号の設定
                For i = 0 To TokenCount
                    TokenStack(i).SeqNo = -1
                Next i
                For i = 0 To InstCount
                    TokenStack(Inst(i)).SeqNo = i
                Next i

                'スクリプトの解析結果の出力
                c = ""
                For i = 0 To TokenCount
                    If (TokenStack(i).SeqNo >= 0) Then cc = CStr(TokenStack(i).SeqNo) Else cc = "-"
                    c = c & Right(Space(5) & CStr(i), 6) _
                          & Right(Space(5) & cc, 6) _
                          & Right(Space(5) & CStr(TokenStack(i).Type), 6) _
                          & Right(Space(11) & CStr(TokenStack(i).Value), 12) _
                          & Space(2) & TokenStack(i).String & vbLf
                Next i
                ActiveSheet.Range(CallerAddress).Comment.Text ActiveSheet.Range(CallerAddress).Comment.Text & c
            End If
        Else
            LL = ErrorMessage("スクリプトではありません。")
        End If

        'メッセージが無かったら、メッセージ表示領域を削除
        If (Len(ActiveSheet.Range(CallerAddress).Comment.Text) < 10) Then ActiveSheet.Range(CallerAddress).Comment.Delete

        '次の実行要求
        i = InStr(ActiveSheet.Scripts.Item(1).ScriptText, ",")
    Loop
        
    '実行完了時刻を保存
    TimeAtLastExecution = Timer

End Sub
Function ExecuteMacro() As Boolean

'マクロ実行制御関数

    Dim n As Long
    Dim i As Long
    Dim cell As CellRange

    n = 0
    For i = TokenCount - 3 To 0 Step -1
        If (TokenStack(i).Type = Lex.ipCellAddress) Then
            If (isCellRange(CStr(TokenStack(i).String), cell)) Then
                n = n + 1
                ReDim Preserve Args(n)
                Args(n) = cell
            End If
        ElseIf (TokenStack(i).Type = Lex.ipNumeric) Then
                n = n + 1
                ReDim Preserve Args(n)
                Args(n).Value = TokenStack(i).Value
        End If
    Next i
    Run (TokenStack(TokenCount - 2).String)
    ExecuteMacro = True
    
End Function
Function ParserConstants() As Boolean

'字句解析用定数の定義

    Lex.OpenBrace = "[{("       '開きカッコ
    Lex.CloseBrace = "]})"      '閉じカッコ
    Lex.Delimiter = ",;:"       '区切り記号
    Lex.Operator = ""           '全演算子
    Lex.AsignOperator = "=@@@+=@@-=@@*=@@/=@@%=@@"                                  '代入演算子
    Lex.ipAsignOperator = "   0   0   0   0   0   0"                                '代入演算子の優先順位
    Lex.RelationalOperator = "||@@&&@@~~@@|@@@&@@@~@@@imp@eqv@xor@or@@and@not@"     '論理演算子
    Lex.ipRelationalOperator = "   1   1   1   1   1   1   1   1   1   1   1   1"   '論理演算子の優先順位
    Lex.ComparativeOperator = "<@@@<=@@=@@@==@@>=@@>@@@<>@@is@@like"                '比較演算子
    Lex.ipComparativeOperator = "   2   2   2   2   2   2   2   2   2"              '比較演算子の優先順位
    Lex.ArithmeticOperator = "&@@@+@@@-@@@%@@@mod@\@@@*@@@/@@@<<@@>>@@++@@--@@"     '算術演算子
    Lex.ipArithmeticOperator = "   3   4   4   5   5   5   5   5   6   6   7   7"   '算術演算子の優先順位
    Lex.UnaryOperator = "~@@@~~@@not@+@@@-@@@"                                      '単項演算子
    Lex.ipUnaryOperator = "   8   8   8   8   8"                                    '単項演算子の優先順位
    Lex.ExponentialOperator = "^@@@"                                                '指数演算子
    Lex.ipExponentialOperator = "   9"                                              '指数演算子の優先順位
    Lex.Operator = Lex.AsignOperator & Lex.RelationalOperator & Lex.ComparativeOperator & Lex.ArithmeticOperator & Lex.UnaryOperator & Lex.ExponentialOperator
    Lex.ipOrderOfPriority = Lex.ipAsignOperator & Lex.ipRelationalOperator & Lex.ipComparativeOperator & Lex.ipArithmeticOperator & Lex.ipUnaryOperator & Lex.ipExponentialOperator
    Lex.ipEndOfScript = 0               'スクリプトの終了
    Lex.ipName = 1                      '名前
    Lex.ipNumeric = 2                   '数値
    Lex.ipString = 3                    '文字列
    Lex.ipComment = 4                   '注釈
    Lex.ipDot = 5                       'ドット
    Lex.ipOpenBrace = 6                 '開きカッコ
    Lex.ipCloseBrace = 7                '閉じカッコ
    Lex.ipOperator = 8                  '演算子
    Lex.ipDelimiter = 9                 '区切り記号
    Lex.ipIllegalToken = 10             '不正トークン
    Lex.ipFunction = 11                 '関数
    Lex.ipCellAddress = 12              'セル番地（範囲）
    Lex.ipPriorityAsignOperator = CInt(Mid(Lex.ipAsignOperator, 1, 4))     '代入演算子の優先順位
    Lex.ipPriorityUnaryOperator = CInt(Mid(Lex.ipUnaryOperator, 1, 4))     '単項演算子の優先順位

End Function
Function ScriptFormalize(Script As String) As String

'スクリプトを標準形式に変更する

    Dim Found As Boolean
    Dim Par As Integer
    Dim Quo As Boolean
    Dim i As Integer, ip As Integer
    Dim k As Integer, kP As Integer
    Dim n As Integer
    Dim c As String, cc As String

    c = Script

    '式表題を読み飛ばす（ダブルクォートやカッコで括られていないカンマを見つける）
    Found = False
    Par = 0
    Quo = False
    i = 4   'スクリプト先頭の"="は既に除かれているので、"exe("の左カッコにポインタを置く
    n = Len(c)
    Do While (Not Found)
        i = i + 1
        cc = Mid(c, i, 1)
        If (cc = """") Then
            If (Quo) Then Quo = False Else Quo = True
        ElseIf (cc = "(") Then
            Par = Par + 1
        ElseIf (cc = ")") Then
            Par = Par - 1
        ElseIf (cc = ",") Then
            If ((Not Quo) And (Par = 0)) Then Found = True
        End If
        If (i >= n) Then Found = True
    Loop

    '式表題以降のスクリプトを処理する
    If (i > 0) Then
        i = InStr(i, c, ",")
        c = "exe(" & Mid(c, i + 1)  '式表題の次のカンマまでを除いて、以降の文字列を引数として"exe(引数)"の形式にする
        i = 4
        k = Len(c)
        If (Mid(c, i + 1, 1) = """" And Mid(c, k - 1, 1) = """") Then   '式全体をダブルクォートで括った拡張形式
            c = Left(c, i) & Mid(c, i + 2, k - i - 3) & Mid(c, k)
        Else                                                            '式の一部をダブルクォートで括った拡張形式
            i = InStr(i + 1, c, """")
            Do While (i > 0)
                k = InStr(i + 1, c, """")
                If (k > 0) Then
                    cc = Left(Mid(c, i + 1, k - i - 1) & "@@@@", 4) 'ダブルクォートで括った文字列の取り出し
                    If (InStr(Lex.Operator, cc) > 0) Then           '拡張演算子なら、ダブルクォートと前後のカンマを削除し、前後にブランクを入れる
                        If (Mid(c, i - 1, 1) = ",") Then ip = i - 2 Else ip = i - 1
                        If (Mid(c, k + 1, 1) = ",") Then kP = k + 2 Else kP = k + 1
                        c = Left(c, ip) & " " & Mid(c, i + 1, k - i - 1) & " " & Mid(c, kP)
                        k = k - 3
                    End If
                End If
                i = InStr(k + 1, c, """")
            Loop
        End If
    End If
    ScriptFormalize = c

End Function
Function ScriptParser() As Boolean

'スクリプトの字句解析

    Dim L As Boolean
    Dim LL As Boolean
    Dim c As String
    Dim i As Integer
    Dim k As Integer
    Dim n As Integer
    Dim Col As Long
    Dim Row As Long
    Dim nTkn As Token

    Tkn = GetToken()
    Do While (Tkn.Type <> Lex.ipEndOfScript)

        Select Case Tkn.Type
        Case Lex.ipName                     '名前
            L = PushToken(Tkn)
        Case Lex.ipNumeric                  '数値
            L = PushToken(Tkn)
        Case Lex.ipString                   '文字列
            L = PushToken(Tkn)
        Case Lex.ipComment                  '注釈
        Case Lex.ipDot                      'ドット
            LL = SyntaxError("不正字句：ドットは使用できません。", Tkn)
        Case Lex.ipOpenBrace                '開きカッコ
            L = PopToken(nTkn)
            If (nTkn.Type = Lex.ipName) Then
                nTkn.Type = Lex.ipFunction          '開きカッコの前の名前を関数名に変更
            End If
            L = PushToken(nTkn)
            L = PushToken(Tkn)
        Case Lex.ipCloseBrace               '閉じカッコ
            L = PushToken(Tkn)
        Case Lex.ipOperator                 '演算子
            L = PushToken(Tkn)
        Case Lex.ipDelimiter                '区切り記号
            L = PopToken(nTkn)
            If (nTkn.Type = Lex.ipName And Tkn.String = ":") Then
                Tkn = GetToken()
                Tkn.Type = Lex.ipCellAddress        '区切り記号の前の名前と組み合わせてセル範囲に変更
                Tkn.String = nTkn.String & ":" & Tkn.String
                L = PushToken(Tkn)
            Else
                L = PushToken(nTkn)
                L = PushToken(Tkn)                  '一般の区切り記号
            End If
        Case Lex.ipIllegalToken             '不正文字
            LL = SyntaxError("不正文字：字句解析できません。", Tkn)
        Case Lex.ipEndOfScript              'スクリプトの終了
            Exit Do
        End Select

        Tkn = GetToken()
    Loop

    '名前トークンの型の設定及びセル番地（範囲）トークンの妥当性判定
    For i = 0 To TokenCount
        If (TokenStack(i).Type = Lex.ipName) Then
            If (isCellAddress(TokenStack(i).String, Col, Row)) Then
                TokenStack(i).Type = Lex.ipCellAddress      'セル番地に変更
            Else
                n = InStr(Lex.Operator, Left(LCase(TokenStack(i).String & "@@@"), 4))
                If (n > 0) Then
                    TokenStack(i).Type = Lex.ipOperator     '演算子に変更
                    TokenStack(i).Value = CInt(Mid(Lex.ipOrderOfPriority, n, 4))
                Else
                    LL = SyntaxError("不正字句（名前）：名前はセル番地（範囲）か、既定の演算子でなければなりません。", TokenStack(i))
                End If
            End If
        End If
        If (TokenStack(i).Type = Lex.ipCellAddress) Then
            If (Not isInRange(UsedRange, TokenStack(i).String)) Then LL = SyntaxError("不正セル番地（範囲）：シートの使用範囲外です。", TokenStack(i))
        End If
    Next i

End Function
Function ScriptAnalyzer() As Boolean

'スクリプトの文解析

    Dim L As Boolean
    Dim LL As Boolean

    L = PopToken(Tkn)
    If (L And Tkn.Type = Lex.ipFunction) Then
        LL = ScriptFunctionCall()           '関数呼出し
    Else
        LL = SyntaxError("スクリプト解析エラー：関数呼出しの形式でなければなりません。", Tkn)
    End If

End Function
Function ScriptFunctionCall() As Boolean

' 関数呼出しの解析

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Long

    i = Tkn.SeqNo
    L = PopToken(Tkn)
    If (L And Tkn.Type = Lex.ipOpenBrace) Then
        LL = ScriptExpressionSet()              '引数（式集合）
        L = PushInst(i)                         '関数名
    Else
        LL = SyntaxError("関数呼出解析エラー：開きカッコがありません。", Tkn)
    End If

End Function
Function ScriptExpressionSet() As Boolean

' 式集合の解析

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Integer
    Dim k As Integer
    Dim n As Integer
    Dim Link As Long
    Dim FstLink As Long
    Dim NxtLink As Long
    Dim nTkn As Token
    Dim mTkn As Token

    L = PushStack(Tkn.SeqNo)
    FstLink = InstCount + 1                     '式集合の中の先頭の式のへのリンク
    NxtLink = FstLink                           '式集合の中の次の式へのリンク
    n = 0
    L = PopToken(Tkn)
    Do While (L And Tkn.Type <> Lex.ipEndOfScript)
        If (Tkn.Type = Lex.ipDelimiter Or Tkn.Type = Lex.ipCloseBrace) Then
            LL = ScriptTerminator()             '終端記号（区切り記号、閉じカッコ）
            If ((InstCount < NxtLink) And (n > 0 Or Tkn.Type = Lex.ipDelimiter)) Then
                L = PushInst(Tkn.SeqNo)         '空の式を区切り記号で表す
            End If
            n = n + 1
            If (n > 1) Then                     '式が２個以上の場合、式の評価順序を後ろの式からに変更する
                For i = NxtLink To InstCount
                    Link = Inst(i)
                    For k = (i - 1) To (FstLink + i - NxtLink) Step -1
                        Inst(k + 1) = Inst(k)
                    Next k
                    Inst(FstLink + i - NxtLink) = Link
                Next i
            End If
            NxtLink = InstCount + 1             '式集合の中の次の式の先頭へのリンク
            If (Tkn.Type = Lex.ipCloseBrace) Then Exit Do
            L = PopToken(Tkn)
        End If
        If (PopToken(nTkn)) Then
            If (Tkn.Type = Lex.ipCellAddress And nTkn.Type = Lex.ipOperator And nTkn.Value = Lex.ipPriorityAsignOperator) Then
                mTkn = Tkn
                L = PopToken(Tkn)
                LL = ScriptExpression()         '代入文
                LL = ScriptTerminator()         '式の終端処理
                L = PushInst(nTkn.SeqNo)
                L = PushInst(mTkn.SeqNo)
            Else
                L = PushToken(nTkn)
                LL = ScriptExpression()         '式
            End If
        Else
            LL = ScriptExpression()             '式
        End If
    Loop

End Function
Function ScriptExpression() As Boolean

' 式の解析

    Dim L As Boolean
    Dim LL As Boolean

    L = True
    If (Tkn.Type = Lex.ipOperator) Then
        LL = ScriptUnaryOperator()              '単項演算子
        L = PopToken(Tkn)
    End If
    Do While (L And Tkn.Type <> Lex.ipEndOfScript)
        LL = ScriptTerm()                       '項
        L = PopToken(Tkn)
        If (L And Tkn.Type = Lex.ipOperator) Then
            LL = ScriptBinaryOperator()         '２項演算子
            L = PopToken(Tkn)
        Else
            Exit Do
        End If
    Loop

End Function
Function ScriptTerm() As Boolean

' 項の解析

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Long

    If (Tkn.Type <= Lex.ipString Or Tkn.Type = Lex.ipCellAddress) Then  '名前、数値、文字列、セル番地
        LL = ScriptFactor()                 '要素
    ElseIf (Tkn.Type = Lex.ipOpenBrace) Then                            '開きカッコ
        LL = ScriptExpressionSet()          '式集合
    ElseIf (Tkn.Type = Lex.ipFunction) Then                             '関数名
        LL = ScriptFunctionCall()           '関数呼出し
    Else
        LL = SyntaxError("項の解析エラー：項として認識できない字句です。", Tkn)
    End If

End Function
Function ScriptFactor() As Boolean

' 要素

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Long

    L = PushInst(Tkn.SeqNo)

End Function
Function ScriptUnaryOperator() As Boolean

' 単項演算子

    Dim L As Boolean
    Dim LL As Boolean
    Dim n As Integer

    n = InStr(Lex.UnaryOperator, Left(Tkn.String & "@@@", 4))
    If (n > 0) Then
        TokenStack(Tkn.SeqNo).Value = CInt(Mid(Lex.ipUnaryOperator, n, 4))
        L = PushStack(Tkn.SeqNo)
    Else
        LL = SyntaxError("単項演算子解析：既定の単項演算子ではありません。", Tkn)
    End If

End Function
Function ScriptBinaryOperator() As Boolean

' ２項演算子

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Long
    Dim k As Long

    L = PopStack(i) '現在の演算子より優先順位が高い演算子を命令スタックに積む。
    Do While (L And TokenStack(i).Type = Lex.ipOperator And TokenStack(i).Value >= Tkn.Value)
        L = PushInst(i)
        L = PopStack(i)
    Loop
    If (L) Then L = PushStack(i)
    L = PushStack(Tkn.SeqNo)

End Function
Function ScriptTerminator() As Boolean

' 終端記号

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Long

    L = PopStack(i)                 '開きカッコの後ろの未処理字句を処理する
    Do While (L And TokenStack(i).Type <> Lex.ipOpenBrace)
        L = PushInst(i)
        L = PopStack(i)
    Loop
    If (L) Then                     '閉じカッコの前までは開きカッコをスタックに残しておく
        If (Tkn.Type <> Lex.ipCloseBrace) Then
            L = PushStack(i)
        End If
    End If

End Function
Function GetToken() As Token

' 字句の取得

' Script   ：入出力、処理する文字列
' GetToken ：出力　、字句

' Token.type = 0：スクリプトの終わり
'              1：名前
'              2：数値
'              3：文字列
'              4：注釈
'              5：ドット
'              6：開きカッコ
'              7：閉じカッコ
'              8：演算子
'              9：区切り記号
'             10：不正

    Dim i As Integer    '文字列から一つずつ取り出す文字のポインタ
    Dim n As Integer    '
    Dim c As String     '文字列から一つずつ取り出した文字
    Dim ch As String    '演算子検索用として構成し直した文字列
    Dim cc As Long      '文字列から一つずつ取り出した文字（ｃ）のアスキーコード

    i = 1
    c = Mid(Script, i, 1)
    Do While (c <> "" And c <= " ")
        i = i + 1
        c = Mid(Script, i, 1)
    Loop
    Script = Mid(Script, i)

    If (Script <> "") Then
        i = 1
        c = LCase(Mid(Script, i, 1))
        cc = Asc(c)

        '名前：先頭がアルファベット［a-z,A-Z］、記号［_,$,@］、２バイト文字の何れかの文字から始まる。
        '　　　２文字目以降はアルファベット［a-z,A-Z］、数字［0-9］、記号［_,$,@］、２バイト文字が続く。
        If (("a" <= c And c <= "z") Or c = "_" Or c = "$" Or c = "@" Or (cc < 0 Or 256 < cc)) Then
            Do While (c <> "" And (("a" <= c And c <= "z") Or ("0" <= c And c <= "9") Or c = "_" Or c = "$" Or c = "@" Or (cc < 0 Or 256 < cc)))
                i = i + 1
                c = LCase(Mid(Script, i, 1))
                If (c <> "") Then cc = Asc(c)
            Loop
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 1
            GetToken.Value = 0

        '数値：先頭が数字で始まる。
        '　　　整数　　　　：２文字目以降にゼロ個以上の数字が続く。
        '　　　固定小数点数：整数の後ろに小数点［.］が一つ現れ、その後にゼロ個以上の数字が続く。
        '　　　指数形式実数：整数または固定小数点数の後ろに指数を表す１文字［e,E,d,D］が現れ、
        '　　　　　　　　　　その後ろにゼロまたは１個の符号［+,-］が続き、さらに整数が続く。
        '　　　１６進数　　：先頭数字［0］の後に１６進数を表す１文字［x,X］が現れ、その後ろに数字及び英字［a-f,A-F］が続く。
        ElseIf ("0" <= c And c <= "9") Then
            Do While (c <> "" And (("0" <= c And c <= "9") Or c = "." Or c = "e" Or c = "d"))
                If (c = "e" Or c = "d") Then
                    c = LCase(Mid(Script, i + 1, 1))
                    If (c = "+" Or c = "-") Then
                        c = LCase(Mid(Script, i + 2, 1))
                        If ("0" <= c And c <= "9") Then
                            i = i + 2
                        Else
                            i = i + 1
                            Exit Do
                        End If
                    ElseIf ("0" <= c And c <= "9") Then
                        i = i + 1
                    Else
                        Exit Do
                    End If
                End If
                i = i + 1
                c = LCase(Mid(Script, i, 1))
            Loop
            If (c = "x" And i = 2) Then
                i = i + 1
                c = LCase(Mid(Script, i, 1))
                Do While (c <> "" And (("0" <= c And c <= "9") Or ("a" <= c And c <= "f")))
                    i = i + 1
                    c = LCase(Mid(Script, i, 1))
                Loop
                GetToken.String = Left(Script, i - 1)
                GetToken.Type = 2
                GetToken.Value = CLng("&h" & Mid(GetToken.String, 3))
            Else
                GetToken.String = Left(Script, i - 1)
                GetToken.Type = 2
                GetToken.Value = CDbl(GetToken.String)
            End If

        '文字列：先頭がダブルクォート［"］で始まる。
        '　　　　２文字目以降にゼロ個以上の任意の文字が続いた後、ダブルクォート［"］で終わる。
        '　　　　文字列にダブルクォートを含める場合は、２つのダブルクォート[""]で１つのダブルクォートと解釈する。
        ElseIf (c = """") Then
            Script = Mid(Script, 2)
            i = 0
            Do While (c <> "")
                i = i + 1
                c = Mid(Script, i, 1)
                If (c = """") Then
                    If (Mid(Script, i + 1, 1) = """") Then
                        Script = Left(Script, i) & Mid(Script, i + 2)
                    Else
                        Exit Do
                    End If
                End If
            Loop
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 3
            GetToken.Value = 0
            i = i + 1

        '文字列：先頭がシングルクォート［'］で始まる。
        '　　　　２文字目以降にゼロ個以上の任意の文字が続いた後、シングルクォート［'］で終わる。
        '　　　　文字列にシングルクォートを含める場合は、２つのシングルクォート['']で１つのシングルクォートと解釈する。
        ElseIf (c = "'") Then
            Script = Mid(Script, 2)
            i = 0
            Do While (c <> "")
                i = i + 1
                c = Mid(Script, i, 1)
                If (c = "'") Then
                    If (Mid(Script, i + 1, 1) = "'") Then
                        Script = Left(Script, i) & Mid(Script, i + 2)
                    Else
                        Exit Do
                    End If
                End If
            Loop
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 3
            GetToken.Value = Asc(GetToken.String)
            i = i + 1

        '注釈：先頭が［/*］で始まり、［*/］で終わる。
        ElseIf (c = "/" And Mid(Script, i + 1, 1) = "*") Then
            Script = Mid(Script, 3)
            i = 0
            Do While (c <> "")
                i = i + 1
                c = Mid(Script, i, 1)
                If (c = "*" And Mid(Script, i + 1, 1) = "/") Then Exit Do
            Loop
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 4
            GetToken.Value = 0
            i = i + 2
        
        '注釈：先頭が［//］で始まり、行末で終わる。
        ElseIf (c = "/" And Mid(Script, i + 1, 1) = "/") Then
            Script = Mid(Script, 3)
            i = 0
            Do While (c <> "")
                i = i + 1
                c = Mid(Script, i, 1)
                If (c = vbCr Or c = vbLf) Then Exit Do
            Loop
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 4
            GetToken.Value = 1
            i = i + 1
            c = Mid(Script, i, 1)
            If (c = vbCr Or c = vbLf) Then i = i + 1

        'ドット
        ElseIf (c = ".") Then
            i = i + 1
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 5
            GetToken.Value = 0

        '開きカッコ記号
        ElseIf (c = "[" Or c = "{" Or c = "(") Then
            i = i + 1
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 6
            GetToken.Value = InStr(Lex.OpenBrace, GetToken.String)

        '閉じカッコ記号
        ElseIf (c = "]" Or c = "}" Or c = ")") Then
            i = i + 1
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 7
            GetToken.Value = InStr(Lex.CloseBrace, GetToken.String)

        '演算子：第１文字： =   ^   *   /   %   +   -   ~   &   |   <   >   #   !   ?   \
        ElseIf (c = "=" Or c = "^" Or c = "*" Or c = "/" Or c = "%" Or c = "+" Or c = "-" Or c = "~" Or c = "&" Or c = "|" Or _
                c = "<" Or c = ">" Or c = "#" Or c = "!" Or c = "?" Or c = "\") Then
            i = i + 1
            ch = c & "@@@"
            c = c & LCase(Mid(Script, i, 1))
            If (InStr(Lex.Operator, c & "@@") > 0) Then
                i = i + 1
                ch = c & "@@"
            End If
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 8
            n = InStr(Lex.Operator, ch)
            If (n > 0) Then         '演算の優先順位
                GetToken.Value = CInt(Mid(Lex.ipOrderOfPriority, n, 4))
            Else
                GetToken.Value = 0
            End If

        '区切り記号： ,  ;  :
        ElseIf (c = "," Or c = ";" Or c = ":") Then
            i = i + 1
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 9
            GetToken.Value = InStr(Lex.Delimiter, GetToken.String)

        '不正文字
        Else
            i = i + 1
            GetToken.String = Left(Script, i - 1)
            GetToken.Type = 10
            GetToken.Value = 0
        End If
        Script = Mid(Script, i)
    Else
        GetToken.String = "End_of_Token"
        GetToken.Type = 0
        GetToken.Value = 0
    End If

    If (InStr(Dbg, ",GetToken,") > 0) Then
        ActiveSheet.Range(CallerAddress).Comment.Text ActiveSheet.Range(CallerAddress).Comment.Text _
                                                        & Right(Space(3) & CStr(GetToken.Type), 4) _
                                                        & Right(Space(3) & CStr(GetToken.Value), 4) _
                                                        & Space(2) & GetToken.String & vbLf
    End If

End Function
Function isCellAddress(a As String, Col As Long, Row As Long) As Boolean

'字句（名前）がセル番地か否かの判定およびセルの行列番号への変換

' a            ：入力、字句（名前）の文字列
' Col          ：出力、セル番地の列番号
' Row          ：出力、セル番地の行番号
' isCellAddress：出力、字句（名前）がセル番地か否かの判定値、True：セル番地、False：セル番地以外

    Dim i  As Integer
    Dim c  As String

    Col = 0
    Row = 0
    i = 1
    c = LCase(Mid(a, i, 1))
    Do While c <> ""
        If ("a" <= c And c <= "z") Then
            Col = 26 * Col + (Asc(c) - Asc("a") + 1)
        ElseIf (c <> "$") Then
            Exit Do
        End If
        If (Col > 1000000) Then
            Col = 0
            Exit Do
        End If
        i = i + 1
        c = LCase(Mid(a, i, 1))
    Loop
    Do While c <> ""
        If ("0" <= c And c <= "9") Then
            Row = 10 * Row + (Asc(c) - Asc("0"))
        Else
            Exit Do
        End If
        If (Row > 1000000) Then
            Row = 0
            Exit Do
        End If
        i = i + 1
        c = LCase(Mid(a, i, 1))
    Loop
    If (c = "" And Col > 0 And Row > 0) Then
        isCellAddress = True
    Else
        isCellAddress = False
    End If

End Function
Function isCellRange(a As String, cell As CellRange) As Boolean

'字句（名前）がセル範囲か否かの判定およびセル範囲型への変換

' a          ：入力、字句（名前）の文字列
' cell       ：出力、セル範囲
' isCellRange：出力、字句（名前）がセル範囲か否かの判定値、True：セル範囲、False：セル範囲以外

    Dim i  As Integer
    Dim c  As String
    Dim Row  As Long
    Dim Col  As Long

    i = InStr(a, ":")
    If (i > 0) Then
        c = Left(a, i - 1)
    Else
        c = a
    End If
    If (isCellAddress(c, Col, Row)) Then
        cell.Column = Col
        cell.Row = Row
        If (i > 0) Then
            c = Mid(a, i + 1)
            If (isCellAddress(c, Col, Row)) Then
                cell.ColumnCount = Col - cell.Column + 1
                cell.RowCount = Row - cell.Row + 1
                isCellRange = True
            Else
                isCellRange = False
            End If
        Else
            cell.ColumnCount = 1
            cell.RowCount = 1
            isCellRange = True
        End If
    Else
        isCellRange = False
    End If

End Function
Function isInRange(rng As CellRange, a As String) As Boolean

'セル範囲がシートのデータ領域範囲内か否かの判定

' rng      ：入力、シートのデータ領域範囲
' a        ：入力、セル範囲の文字列
' isInRange：出力、セル範囲がデータ領域範囲内か否かの判定値、True：範囲内、False：範囲外

    Dim cell As CellRange

    If (isCellRange(a, cell)) Then
        If (rng.Row <= cell.Row And cell.Row + cell.RowCount <= rng.Row + rng.RowCount And _
            rng.Column <= cell.Column And cell.Column + cell.ColumnCount <= rng.Column + rng.ColumnCount) Then
            isInRange = True
        Else
            isInRange = False
        End If
    Else
        isInRange = False
    End If

End Function
Function PushToken(a As Token) As Boolean

'字句の格納

    TokenCount = TokenCount + 1
    If (TokenCount >= UBound(TokenStack)) Then
        ReDim Preserve TokenStack(TokenCount + 10)
    End If
    TokenStack(TokenCount).String = a.String
    TokenStack(TokenCount).Type = a.Type
    TokenStack(TokenCount).Value = a.Value
    TokenStack(TokenCount).SeqNo = a.SeqNo
    PushToken = True

End Function
Function PopToken(a As Token) As Boolean

'字句の取出し

    If (TokenCount >= 0) Then
        a.String = TokenStack(TokenCount).String
        a.Type = TokenStack(TokenCount).Type
        a.Value = TokenStack(TokenCount).Value
        a.SeqNo = TokenStack(TokenCount).SeqNo
        TokenCount = TokenCount - 1
        PopToken = True
    Else
        PopToken = False
    End If

End Function
Function PushInst(a As Variant) As Boolean

'実行順序番号の格納

    InstCount = InstCount + 1
    If (InstCount >= UBound(Inst)) Then
        ReDim Preserve Inst(InstCount + 10)
    End If
    Inst(InstCount) = a
    PushInst = True

End Function
Function PopInst(a As Variant) As Boolean

'実行順序番号の取出し

    If (InstCount >= 0) Then
        a = Inst(InstCount)
        InstCount = InstCount - 1
        PopInst = True
    Else
        PopInst = False
    End If

End Function
Function PushStack(a As Variant) As Boolean

'スタックへの格納

    StackCount = StackCount + 1
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = a
    PushStack = True

End Function
Function PopStack(a As Variant) As Boolean

'スタックからの取出し

    If (StackCount >= 0) Then
        a = Stack(StackCount)
        StackCount = StackCount - 1
        PopStack = True
    Else
        PopStack = False
    End If

End Function
Function SyntaxError(c As String, a As Token) As Boolean

'文法エラーの処理

    Dim LL As Boolean
    Dim msg As String

    msg = c & "／／ トークンの番号＝" & CStr(a.SeqNo) & "、型＝" & CStr(a.Type) & "、文字列＝" & a.String & "、値＝" & CStr(a.Value)
    LL = ErrorMessage(msg)
    ErrLoc = InstLoc

End Function
Function ExecuteScript() As Boolean

' スクリプトの実行

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Integer
    Dim k As Integer
    Dim n As Integer
    Dim m As Integer
    Dim a() As Variant
    Dim rng As Range
    Dim nTkn As Token

    On Error GoTo Abort

    InstCount = InstCount - 2   '関数（exe）を削除

    For InstLoc = 0 To InstCount
        ScriptNo = Inst(InstLoc)
        Tkn = TokenStack(ScriptNo)
        Select Case Tkn.Type

        Case Lex.ipNumeric      '数値
            L = PushData(Tkn.Value)

        Case Lex.ipString       '文字列
            L = PushData(Tkn.String)

        Case Lex.ipCellAddress  'セル範囲
            Set rng = ActiveSheet.Range(Tkn.String)
            L = GetArrayRange(a, rng)
            L = PushArray(a)

        Case Lex.ipOperator     '演算子
            If (Tkn.Value = Lex.ipPriorityAsignOperator) Then
                InstLoc = InstLoc + 1
                ScriptNo = Inst(InstLoc)
                nTkn = TokenStack(ScriptNo)
                LL = ExecuteAsignOperator(Tkn, nTkn)   '代入演算子
            ElseIf (Tkn.Value = Lex.ipPriorityUnaryOperator) Then
                LL = ExecuteUnaryOperator(Tkn)         '単項演算子
            Else
                LL = ExecuteBinaryOperator(Tkn)        '２項演算子
            End If

        Case Lex.ipFunction     '関数の実行
            LL = ExecuteFunction(Tkn)

        Case Lex.ipDelimiter    '式集合の中で省略された式の替わりにゼロを設定
            L = PushData(0#)

        Case Else
            ExecutionError ("定義されていない演算コードです。---" & Tkn.String)
        End Select
    Next InstLoc
    Exit Function
    
Abort:
    ExecutionError ("スクリプト実行時にエラーが発生しました")
    Resume Next

End Function
Function ExecuteAsignOperator(Tkn As Token, nTkn As Token) As Boolean

' 代入演算子の実行

    Dim L As Boolean
    Dim LL As Boolean
    Dim i As Integer
    Dim n As Integer
    Dim Chr As String
    Dim lng As Long
    Dim Dbl As Double
    Dim a() As Variant
    Dim b() As Variant
    Dim c() As Variant
    Dim rng As Range

    On Error GoTo Abort

    Select Case LCase(Tkn.String)
    Case "="
        Set rng = ActiveSheet.Range(nTkn.String)
        L = PutArrayRange(PopArray(), rng)
    Case "+="
        Set rng = ActiveSheet.Range(nTkn.String)
        L = GetArrayRange(a, rng)
        b = PopArray()
        n = UBound(a)
        ReDim c(n)
        For i = 1 To n
            c(i) = a(i) + b(i)
        Next i
        L = PutArrayRange(c, rng)
    Case "-="
        Set rng = ActiveSheet.Range(nTkn.String)
        L = GetArrayRange(a, rng)
        b = PopArray()
        n = UBound(a)
        ReDim c(n)
        For i = 1 To n
            c(i) = a(i) - b(i)
        Next i
        L = PutArrayRange(c, rng)
    Case "*="
        Set rng = ActiveSheet.Range(nTkn.String)
        L = GetArrayRange(a, rng)
        b = PopArray()
        n = UBound(a)
        ReDim c(n)
        For i = 1 To n
            c(i) = a(i) * b(i)
        Next i
        L = PutArrayRange(c, rng)
    Case "/="
        Set rng = ActiveSheet.Range(nTkn.String)
        L = GetArrayRange(a, rng)
        b = PopArray()
        n = UBound(a)
        ReDim c(n)
        For i = 1 To n
            c(i) = a(i) / b(i)
        Next i
        L = PutArrayRange(c, rng)
    Case "%="
        Set rng = ActiveSheet.Range(nTkn.String)
        L = GetArrayRange(a, rng)
        b = PopArray()
        n = UBound(a)
        ReDim c(n)
        For i = 1 To n
            c(i) = a(i) Mod b(i)
        Next i
        L = PutArrayRange(c, rng)
    Case Else
        LL = ExecutionError("定義されていない代入演算子です。--- " & Tkn.String)
    End Select
    Exit Function

Abort:
    LL = ExecutionError("代入演算子の実行時にエラーが発生しました")
    Resume Next

End Function
Function ExecuteUnaryOperator(Tkn As Token) As Boolean

' 単項演算子の実行

    Dim L As Boolean
    Dim LL As Boolean
    Dim Chr As String
    Dim lng As Long
    Dim Dbl As Double

    On Error GoTo Abort

    Select Case LCase(Tkn.String)
    Case "+"
        L = PushData(PopData())
    Case "-"
        L = PushData(-PopData())
    Case "~", "~~", "not"
        L = PushData(Not PopData())
    Case Else
        LL = ExecutionError("定義されていない単項演算子です。--- " & Tkn.String)
    End Select
    Exit Function

Abort:
    LL = ExecutionError("単項演算子の実行時にエラーが発生しました")
    Resume Next

End Function
Function ExecuteBinaryOperator(Tkn As Token) As Boolean

' ２項演算子の実行

    Dim L As Boolean
    Dim LL As Boolean
    Dim Chr As String
    Dim lng As Long
    Dim Dbl As Double

    On Error GoTo Abort

    Select Case LCase(Tkn.String)
    Case "^"
        Dbl = PopData()
        L = PushData(PopData() ^ Dbl)
    Case "*"
        L = PushData(PopData() * PopData())
    Case "/"
        Dbl = PopData()
        L = PushData(PopData() / Dbl)
    Case "mod", "%"
        Dbl = PopData()
        L = PushData(PopData() Mod Dbl)
    Case "\"
        Dbl = PopData()
        L = PushData(Int(PopData() / Dbl))
    Case "+"
        L = PushData(PopData() + PopData())
    Case "-"
        L = PushData(-PopData() + PopData())
    Case "&"
        Chr = PopData()
        L = PushData(PopData() & Chr)
    Case "<"
        If (PopData() > PopData()) Then L = PushData(True) Else L = PushData(False)
    Case "<="
        If (PopData() >= PopData()) Then L = PushData(True) Else L = PushData(False)
    Case "=="
        If (PopData() = PopData()) Then L = PushData(True) Else L = PushData(False)
    Case ">="
        If (PopData() <= PopData()) Then L = PushData(True) Else L = PushData(False)
    Case ">"
        If (PopData() < PopData()) Then L = PushData(True) Else L = PushData(False)
    Case "<>"
        If (PopData() <> PopData()) Then L = PushData(True) Else L = PushData(False)
    Case "and", "&&"
        L = PushData(PopData() And PopData())
    Case "or", "||", "|"
        L = PushData(PopData() Or PopData())
    Case "xor"
        L = PushData(PopData() Xor PopData())
    Case "eqv"
        L = PushData(PopData() Eqv PopData())
    Case "imp"
        L = PushData(PopData() Imp PopData())
    Case "is"
        LL = ExecutionError("オブジェクトの比較演算子（is）はサポートしていません。")
    Case "like"
        Chr = PopData()
        L = PushData(PopData() Like Chr)
    Case Else
        LL = ExecutionError("定義されていない２項演算子です。---" & Tkn.String)
    End Select
    Exit Function

Abort:
    LL = ExecutionError("２項演算子の実行時にエラーが発生しました")
    Resume Next

End Function
Function ExecuteFunction(Tkn As Token) As Boolean

' 関数の実行

    Dim L As Boolean, LL As Boolean
    Dim i As Integer, j As Integer, k As Integer
    Dim m As Integer, n As Integer, n1 As Integer, n2 As Integer, n3 As Integer
    Dim lng As Long, Ln As Long
    Dim Chr As String
    Dim Dbl As Double
    Dim a() As Variant, b() As Variant, c() As Variant
    Dim da() As Double, Db() As Double, Dc() As Double
    Dim aa() As Double, bb() As Double, cc() As Double
    Dim ia() As Integer
    Dim rng As Range
    Dim Cel As CellRange
    Dim Tbl As Table
    Dim ymd As yymmdd
    Dim hms As hhmmss
    Dim Va As Vector3D, Vb As Vector3D, vc As Vector3D
    Dim Ma As Matrix3x3, Mb As Matrix3x3, Mc As Matrix3x3
    Dim Qa As Quaternion, Qb As Quaternion, Qc As Quaternion

    On Error GoTo Abort

    Select Case LCase(Tkn.String)

    'エクセル標準実装関数
    Case "if"           'if(Cond, a ,b)
        If (PopData()) Then
            a = PopArray()
            b = PopArray()
            L = PushArray(a)    'Condが真ならaを使う
        Else
            a = PopArray()
            b = PopArray()
            L = PushArray(b)    'Condが真ならbを使う
        End If

    Case "columns"      'columns(rng)
        Set rng = ActiveSheet.Range(TokenStack(ScriptNo - 2).String)
        n = rng.Columns.Count
        a = PopArray()          'スタックのデータを捨て、列数を入れる
        L = PushData(CDbl(n))

    Case "rows"         'rows(rng)
        Set rng = ActiveSheet.Range(TokenStack(ScriptNo - 2).String)
        n = rng.Rows.Count
        a = PopArray()          'スタックのデータを捨て、行数を入れる
        L = PushData(CDbl(n))

    Case "cos"          'cos(x)
        L = PushData(Cos(PopData()))

    Case "sin"          'sin(x)
        L = PushData(Sin(PopData()))

    Case "pi"           'pi()
        L = PushData(Pi)

    Case "exp"          'exp(x)
        L = PushData(Exp(PopData()))

    'ＳＳＳＬＩＢ関数
    Case "actand"       'Function Actand(s As Double, c As Double) As Double
        L = PushData(Actand(PopData(), PopData()))

    Case "angmat"       'Function AngMat(a() As Double, ix() As Integer) As Matrix3x3
        L = PushMat(AngMat(PopDblArray(), PopIntArray()))

    Case "angqtn"       'Function AngQtn(a() As Double, ix() As Integer) As Quaternion
        L = PushQtn(AngQtn(PopDblArray(), PopIntArray()))

    Case "arcosd"       'Function Arcosd(c As Double) As Double
        L = PushData(Arcosd(PopData()))

    Case "arsind"       'Function Arsind(s As Double) As Double
        L = PushData(Arsind(PopData()))

    Case "artand"       'Function Artand(s As Double, c As Double) As Double
        L = PushData(Artand(PopData(), PopData()))

    Case "arycpy"       'Function AryCpy(a() As Double, ia As Integer, b() As Double, ib As Integer, n As Integer) As Boolean
        L = AryCpy(PopDblArray(), CLng(PopData()), PopDblArray(), CLng(PopData()), CLng(PopData()))
        L = PushData(vbNull)

    Case "azimth"       'Function Azimth(r As Vector3D, V As Vector3D) As Double
        L = PushData(Azimth(PopVct(), PopVct()))

    Case "bindgt"       'Function BinDgt(Bn As Long, n As Integer) As Integer()
        L = PushIntArray(BinDgt(CLng(PopData()), CInt(PopData())))

    Case "cargeo"          'Function CarGeo(r As Vector3D) As Vector3D
        L = PushVct(CarGeo(PopVct()))

    Case "cd7wgs"        'Function Cd7Wgs(Rc As Vector3D, Vc As Vector3D) As Double(6)----ＳＳＳＬＩＢ関数とは引数及び戻り値を変更している
        Va = Cd7Wgs(PopVct(), PopVct(), Vb)
        ReDim a(6)
        a(1) = Va.x
        a(2) = Va.y
        a(3) = Va.z
        a(4) = Vb.x
        a(5) = Vb.y
        a(6) = Vb.z
        L = PushArray(a)

    Case "cosd"         'Function Cosd(Ang As Double) As Double
        L = PushData(Cosd(PopData()))

    Case "dcmqtn"       'Function DcmQtn(a As Matrix3x3) As Quaternion
        L = PushQtn(DcmQtn(PopMat()))

    Case "dcmrav"       'Function DcmRav(a As Matrix3x3) As Vector3D
        L = PushVct(DcmRav(PopMat()))

    Case "deg"          'Function Deg(a As Double) As Double
        L = PushData(Deg(PopData()))

    Case "diff"         'Function Diff(a As Variant, b As Variant) As Variant
        L = PushData(Diff(CVar(PopData()), CVar(PopData())))

    Case "dip"          'Function DIP(r As Vector3D, v As Vector3D, beta As Double) As Vector3D
        L = PushVct(DIP(PopVct(), PopVct(), PopData()))

    Case "dipr"          'Function DIPr(r As Vector3D, v As Vector3D, beta As Double) As Vector3D
        L = PushVct(DIPr(PopVct(), PopVct(), PopData()))

    Case "dipv"          'Function DIPv(r As Vector3D, v As Vector3D, beta As Double) As Vector3D
        L = PushVct(DIPv(PopVct(), PopVct(), PopData()))

    Case "dipx"          'Function DIPx(r As Vector3D, v As Vector3D, beta As Double, RetR As Vector3D, RetV As Vector3D) As Vector3D----ＳＳＳＬＩＢ関数とは引数及び戻り値を変更している
        Va = DIPx(PopVct(), PopVct(), PopData(), Vb, vc)
        ReDim a(9)
        a(1) = Va.x
        a(2) = Va.y
        a(3) = Va.z
        a(4) = Vb.x
        a(5) = Vb.y
        a(6) = Vb.z
        a(7) = vc.x
        a(8) = vc.y
        a(9) = vc.z
        L = PushArray(a)

    Case "drvang"       'Function DrvAng(a As Vector3D, W As Vector3D, ix As Integer) As Vector3D
        L = PushVct(DrvAng(PopVct(), PopVct(), CInt(PopData())))

    Case "drvdcm"       'Function DrvDcm(d As Matrix3x3, W As Vector3D) As Matrix3x3
        L = PushMat(DrvDcm(PopMat(), PopVct()))

    Case "drvqtn"       'Function DrvQtn(q As Quaternion, W As Vector3D) As Quaternion
        L = PushQtn(DrvQtn(PopQtn(), PopVct()))

    Case "drvrav"       'DrvRav(a As Vector3D, W As Vector3D) As Vector3D
        L = PushVct(DrvRav(PopVct(), PopVct()))

    Case "er"           'Function er() As Double
        L = PushData(er())

    Case "geocar"         'Function GeoCar(lat As Double, lng As Double, alt As Double) As Vector3D
        L = PushVct(GeoCar(PopData(), PopData(), PopData()))

    Case "GeoDes"       'Function GeoDes(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Double
        L = PushData(GeoDes(PopData(), PopData(), PopData(), PopData()))

    Case "geogra"       'Function GeoGra(d As variant) As GeoGraphicQuantities
        L = PushGgq(GeoGra(PopDblArray()))

    Case "geopos"       'Function GeoPos(T As Double, F As StateVariables) As GeoGraphicQuantities
        L = PushGgq(GeoPos(PopData(), PopTsv()))

    Case "geoxyz"       'Function GeoXyz(p As GeoGraphicQuantities) As StateVariables
        L = PushTsv(GeoXyz(PopGgq()))
        
    Case "gmst"         'Function Gmst(t As Double) As Double
        L = PushData(Gmst(PopData()))

    Case "gmu"          'Function Gmu() As Double
        L = PushData(Gmu())

    Case "grmsmt"       'Function GrmSmt(a() As Double) As Double()
        L = PushDblArray(GrmSmt(PopDblArray()))

    Case "grnlng"       'Function GrnLng(d As yymmdd, T As hhmmss) As Double
        L = PushData(GrnLng(PopDate(), PopTime()))

    Case "grvacc"       'Function GrvAcc(r As Vector3D) As Vector3D
        L = PushVct(GrvAcc(PopVct()))

    Case "iip"          'Function IIP(r As Vector3D, v As Vector3D) As Vector3D
        L = PushVct(IIP(PopVct(), PopVct()))

    Case "iipr"         'Function IIPr(r As Vector3D, v As Vector3D, A As Double) As Vector3D
        L = PushVct(IIPr(PopVct(), PopVct(), PopData()))

    Case "iipv"         'Function IIPv(r As Vector3D, v As Vector3D, A As Double) As Vector3D
        L = PushVct(IIPv(PopVct(), PopVct(), PopData()))

    Case "iipx"          'Function IIPx(Rv As Vector3D, Vv As Vector3D, Aer As Double, RetR As Vector3D, RetV As Vector3D) As Vector3D----ＳＳＳＬＩＢ関数とは引数及び戻り値を変更している
        Va = IIPx(PopVct(), PopVct(), PopData(), Vb, vc)
        ReDim a(9)
        a(1) = Va.x
        a(2) = Va.y
        a(3) = Va.z
        a(4) = Vb.x
        a(5) = Vb.y
        a(6) = Vb.z
        a(7) = vc.x
        a(8) = vc.y
        a(9) = vc.z
        L = PushArray(a)

    Case "latctg"         'Function LatCtG(Ang As Double) As Double
        L = PushData(LatCtG(PopData()))

    Case "latgtc"         'Function LatGtC(Ang As Double) As Double
        L = PushData(LatGtC(PopData()))

    Case "lchpad"       'Function LchPad(ID as integer) As SiteLocation
        L = PushSite(LchPad(CInt(PopData())))

    Case "lclpos"       'Function LclPos(t As Double, a As SiteLocation) As Vector3D
        L = PushVct(LclPos(PopData(), PopSite()))

    Case "lneqsl"       'Function Lneqsl(a() As Double, m As Integer, n As Integer) As Double()----ＳＳＳＬＩＢ関数とは戻り値を変更している
        a = PopArray()
        m = CInt(PopData())
        n = CInt(PopData())
        ReDim aa(m, n)
        k = 0
        For j = 1 To n
            For i = 1 To m
                k = k + 1
                aa(i, j) = a(k)
            Next i
        Next j
        L = Lneqsl(aa, m, n)
        k = 0
        For j = 1 To n
            For i = 1 To m
                k = k + 1
                a(k) = aa(i, j)
            Next i
        Next j
        L = PushArray(a)

    Case "lokang"       'Function LokAng(T As Double, F As StateVariables, Rs As SiteLocation) As ViewQuantities
        L = PushView(LokAng(PopData(), PopTsv(), PopSite()))

    Case "lsqbep"       'Function LsqBep(x() As Double, y() As Double) As Double()----ＳＳＳＬＩＢ関数とは引数及び戻り値を変更している
        da = PopDblArray()      'x(nD)      ：入力、独立変数テーブル
        b = PopArray()          'y(nD, nY)  ：入力、従属変数（複数可）テーブル
        n1 = 0                  'n1 = nP    ：多項式近似次数
        Ln = UBound(da)         'Ln = nD    ：独立変数及び従属変数のデータ個数
        m = UBound(b) / Ln      'm  = nY    ：従属変数の個数
        ReDim bb(Ln, m)
        k = 0
        For j = 1 To m
            For i = 1 To Ln
                k = k + 1
                bb(i, j) = b(k)
            Next i
        Next j
        n3 = LsqBep(da, bb, Ln, m, cc, n1)
        n2 = n3 + 2
        ReDim aa(n2, m)
        For j = 1 To m
            aa(1, j) = n3
            For i = 2 To n2
                 aa(i, j) = cc(i - 1, j)
            Next i
        Next j
        ReDim Dc(n2 * m)
        k = 0
        For j = 1 To m
            For i = 1 To n2
                k = k + 1
                 Dc(k) = aa(i, j)
            Next i
        Next j
        L = PushDblArray(Dc)   'nP, c(nP+1, nY)   ：出力、最適多項式次数と多項式近似係数テーブル

    Case "lsqpol"       'Function LsqPol(x() As Double, y() As Double, nP As Integer) As Double()----ＳＳＳＬＩＢ関数とは引数及び戻り値を変更している
        da = PopDblArray()      'x(nD)      ：入力、独立変数テーブル
        b = PopArray()          'y(nD, nY)  ：入力、従属変数（複数可）テーブル
        n1 = CInt(PopData())    'n1 = nP    ：入力、多項式近似次数
        Ln = UBound(da)         'Ln = nD    ：独立変数及び従属変数のデータ個数
        m = UBound(b) / Ln      'm  = nY    ：従属変数の個数
        ReDim bb(Ln, m)
        k = 0
        For j = 1 To m
            For i = 1 To Ln
                k = k + 1
                bb(i, j) = b(k)
            Next i
        Next j
        L = LsqPol(da, bb, Ln, m, cc, n1)
        n2 = n1 + 1
        ReDim Dc(n2 * m)
        k = 0
        For j = 1 To m
            For i = 1 To n2
                k = k + 1
                 Dc(k) = cc(i, j)
            Next i
        Next j
        L = PushDblArray(Dc)    ' c(nP+1, nY)   ：出力、多項式近似係数テーブル

    Case "matang"       'Function MatAng(iv As Matrix3x3, ir As Matrix3x3, im As Matrix3x3) As Vector3D
        L = PushVct(MatAng(PopMat(), PopMat(), PopMat()))

    Case "matary"       'Function MatAry(m As Matrix3x3) As Double
        L = PushDblArray(MatAry(PopMat()))

    Case "matrtn"       'Function MatRtn(a As Matrix3x3, b As Double, ix As Integer) As Matrix3x3
        L = PushMat(MatRtn(PopMat(), PopData(), CInt(PopData())))

    Case "mjd"          'Function Mjd(t As Double) As Double
        L = PushData(mjd(PopData()))

    Case "mx31mp"       'Function Mx31Mp(a As Matrix3x3, b As Vector3D) As Vector3D
        L = PushVct(Mx31Mp(PopMat(), PopVct()))

    Case "mx33"         'Function mx33(d11･･･d33 As Double) As Matrix3x3
        L = PushMat(Mx33(PopData(), PopData(), PopData(), PopData(), PopData(), PopData(), PopData(), PopData(), PopData()))

    Case "mx33dt"       'Function Mx33Dt(a As Matrix3x3) As Double
        L = PushData(Mx33Dt(PopMat()))

    Case "mx33iv"       'Function Mx33Iv(a As Matrix3x3) As Matrix3x3
        L = PushMat(Mx33Iv(PopMat()))

    Case "mx33mp"       'Function Mx33Mp(a As Matrix3x3, b As Matrix3x3) As Matrix3x3
        L = PushMat(Mx33Mp(PopMat(), PopMat()))

    Case "mx33tp"       'Function Mx33Tp(a As Matrix3x3) As Matrix3x3
        L = PushMat(Mx33Tp(PopMat()))

    Case "mx33v3"       'Function mx33V3(vx,vy,vz As Vector3D) As Matrix3x3
        L = PushMat(Mx33V3(PopVct(), PopVct(), PopVct()))

    Case "nrmvel"       'Function NrmVel(a As Vector3D, b As Vector3D, c As Vector3D) As Double
        L = PushData(NrmVel(PopVct(), PopVct(), PopVct()))

    Case "odrang"       'Function OdrAng(a As Matrix3x3, ix As Integer) As Vector3D
        L = PushVct(OdrAng(PopMat(), CInt(PopData())))

    Case "orbelm"       'Function OrbElm(t As Double, f As StateVariables) As OrbitalElements
        L = PushOrb(OrbElm(PopData(), PopTsv()))

    Case "orbxyz"       'Function OrbXyz(t As Double, O As OrbitalElements) As StateVariables
        L = PushTsv(OrbXyz(PopData(), PopOrb()))

    Case "polyex"       'Function PolyEx(c() As Double, n As Integer, a As Double) As Double
        L = PushData(PolyEx(PopDblArray(), CInt(PopData()), PopData()))

    Case "qtn"          'Function Qtn(c As Double, sx As Double, sy As Double, sz As Double) As Quaternion
        L = PushQtn(Qtn(PopData(), PopData(), PopData(), PopData()))

    Case "qtnang"       'Function QtnAng(iv As Quaternion, ir As Quaternion, iq As Quaternion) As Vector3D
        L = PushVct(QtnAng(PopQtn(), PopQtn(), PopQtn()))

    Case "qtnary"       'Function QtnAry(q As Quaternion) As Double()
        L = PushDblArray(QtnAry(PopQtn()))

    Case "qtncnj"       'Function QtnCnj(a As Quaternion) As Quaternion
        L = PushQtn(QtnCnj(PopQtn()))

    Case "qtndcm"       'Function QtnDcm(a As Quaternion) As Matrix3x3
        L = PushMat(QtnDcm(PopQtn()))

    Case "qtnrav"       'Function QtnRav(q As Quaternion) As Vector3D
        L = PushVct(QtnRav(PopQtn()))

    Case "qtnrtn"       'Function QtnRtn(a As Quaternion, b As Double, ix As Integer) As Quaternion
        L = PushQtn(QtnRtn(PopQtn(), PopData(), CInt(PopData())))

    Case "qtqqmp"       'Function QtqqMp(a As Quaternion, b As Quaternion) As Quaternion
        L = PushQtn(QtqqMp(PopQtn(), PopQtn()))

    Case "qtqvmp"       'Function QtqvMp(a As Quaternion, b As Vector3D) As Quaternion
        L = PushQtn(QtqvMp(PopQtn(), PopVct()))

    Case "rad"          'Function Rad(a As Double) As Double
        L = PushData(Rad(PopData()))

    Case "ravdcm"       'Function RavDcm(a As Vector3D) As Matrix3x3
        L = PushMat(RavDcm(PopVct()))

    Case "ravqtn"       'Function RavQtn(a As Vector3D) As Quaternion
        L = PushQtn(RavQtn(PopVct()))

    Case "rer"          'Function Rer() As Double
        L = PushData(Rer())

    Case "rtnang"       'Function RtnAng(a As Matrix3x3, ix As Integer) As Vector3D
        L = PushVct(RtnAng(PopMat(), CInt(PopData())))

    Case "rtnmat"       'Function RtnMat(a As Double, ix As Integer) As Matrix3x3
        L = PushMat(RtnMat(PopData(), CInt(PopData())))

    Case "rtnqtn"       'Function RtnQtn(a As Double, ix As Integer) As Quaternion
        L = PushQtn(RtnQtn(PopData(), CInt(PopData())))

    Case "setpad"    'Function SetPad(Lat As Double, Lng As Double, Alt As Double, Az As Double) As Boolean
        L = SetPad(PopData(), PopData(), PopData(), PopData())
        L = PushData(vbNull)

    Case "setref"       'Function SetRef(ID As Integer, tI As Double) As Boolean
        L = SetRef(CInt(PopData()), PopData())
        L = PushData(vbNull)

    Case "settime"       'Function SetTime(day() As Double, time() As Double) As Boolean
        L = SetTime(PopDblArray(), PopDblArray())
        L = PushData(vbNull)

    Case "sind"         'Function Sind(a As Double) As Double
        L = PushData(Sind(PopData()))
        
    Case "site"         'Function Site(Alt As Double, Ltg As Double,Lng As Double,Azl as double) As SiteLocation
        L = PushSite(Site(PopData(), PopData(), PopData(), PopData()))

    Case "quicksort"    'Function quickSort(sD() As Variant, odr As Integer) As Variant()
        L = PushArray(quickSort(PopArray(), PopData()))

    Case "sqrt"         'Function Sqrt(a As Double) As Double
        L = PushData(Sqrt(PopData()))

    Case "stavar"       'Function StaVar(r As Vector3D, v As Vector3D, Qib As Quaternion) As StateVariables
        L = PushTsv(StaVar(PopVct(), PopVct(), PopQtn()))

    Case "stdrnd"       'Function StdRnd() As Double
        L = PushData(StdRnd())

    Case "vct3d"        'Function vct3d(x As Double, y As Double, z As Double) As Vector3D
        L = PushVct(Vct3D(PopData(), PopData(), PopData()))
        
    Case "vctadd"       'Function VctAdd(a As Vector3D, b As Vector3D) As Vector3D
        L = PushVct(VctAdd(PopVct(), PopVct()))

    Case "vctang"       'Function VctAng(a As Vector3D, b As Vector3D) As Double
        L = PushData(VctAng(PopVct(), PopVct()))

    Case "vctary"       'Function VctAry(v As Vector3D) As Double()
        L = PushDblArray(VctAry(PopVct()))

    Case "vctcrp"       'Function VctCrp(a As Vector3D, b As Vector3D) As Vector3D
        L = PushVct(VctCrp(PopVct(), PopVct()))

    Case "vctinp"       'Function VctInp(a As Vector3D, b As Vector3D) As Double
        L = PushData(VctInp(PopVct(), PopVct()))

    Case "vctmag"       'Function VctMag(a As Vector3D) As Double
        L = PushData(VctMag(PopVct()))

    Case "vctnrm"       'Function VctNrm(a As Vector3D) As Vector3D
        L = PushVct(VctNrm(PopVct()))

    Case "vctrtn"       'Function VctRtn(V As Vector3D, a As Double, ix As Integer) As Vector3D
        L = PushVct(VctRtn(PopVct(), PopData(), CInt(PopData())))

    Case "vctsmp"       'Function VctSmp(V As Vector3D, s As Double) As Vector3D
        L = PushVct(VctSmp(PopVct(), PopData()))

    Case "vctsub"       'Function VctSub(a As Vector3D, b As Vector3D) As Vector3D
        L = PushVct(VctSub(PopVct(), PopVct()))

    Case "wer"          'Function Wer() As Double
        L = PushData(Wer())

    Case "wgscd7"       'Function WgsCd7(Rw As Vector3D, Vw As Vector3D) As Vector3D----ＳＳＳＬＩＢ関数とは引数及び戻り値を変更している
        Va = WgsCd7(PopVct(), PopVct(), Vb)
        ReDim a(6)
        a(1) = Va.x
        a(2) = Va.y
        a(3) = Va.z
        a(4) = Vb.x
        a(5) = Vb.y
        a(6) = Vb.z
        L = PushArray(a)
    
    Case Else
        LL = ExecutionError("関数が未定義です。")
    End Select
    Exit Function

Abort:
    LL = ExecutionError("関数の実行時にエラーが発生しました。")
    Resume Next

End Function
Function PushData(a As Variant) As Boolean

'任意型データの格納

    StackCount = StackCount + 2
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 1
    Stack(StackCount - 1) = a
    PushData = True

End Function
Function PopData() As Variant

'任意型データの取出し

    Dim LL As Boolean

    If (StackCount >= 1) Then
        If (Stack(StackCount) = 1) Then
            PopData = Stack(StackCount - 1)
            StackCount = StackCount - 2
        Else
            LL = StackError("スタックから値の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushArray(a() As Variant) As Boolean

'任意型の配列データの格納

    Dim i As Integer
    Dim n As Integer

    n = UBound(a)
    StackCount = StackCount + n + 1
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = n
    For i = 1 To n
        Stack(StackCount - i) = a(i)
    Next i
    PushArray = True

End Function
Function PopArray() As Variant()

'任意型の配列データの取出し

    Dim LL As Boolean
    Dim i As Integer
    Dim n As Integer
    Dim a() As Variant

    If (StackCount >= 0) Then
        n = Stack(StackCount)
        If (StackCount >= n) Then
            ReDim a(n) As Variant
            For i = 1 To n
                a(i) = Stack(StackCount - i)
            Next i
        Else
            LL = StackError("スタックが空です。")
            ReDim a(1) As Variant
            a(1) = vbInf
        End If
        StackCount = StackCount - n - 1
    Else
        LL = StackError("スタックが空です。")
        ReDim a(1) As Variant
        a(1) = vbInf
    End If
    PopArray = a

End Function
Function PushDblArray(a() As Double) As Boolean

'倍精度型の配列データの格納

    Dim i As Integer
    Dim n As Integer

    n = UBound(a)
    StackCount = StackCount + n + 1
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = n
    For i = 1 To n
        Stack(StackCount - i) = CVar(a(i))
    Next i
    PushDblArray = True

End Function
Function PopDblArray() As Double()

'倍精度型の配列データの取出し

    Dim LL As Boolean
    Dim i As Integer
    Dim n As Integer
    Dim a() As Double

    If (StackCount >= 0) Then
        n = Stack(StackCount)
        If (StackCount >= n) Then
            ReDim a(n) As Double
            For i = 1 To n
                a(i) = CDbl(Stack(StackCount - i))
            Next i
        Else
            LL = StackError("スタックが空です。")
            ReDim a(1) As Double
            a(1) = vbInf
        End If
        StackCount = StackCount - n - 1
    Else
        LL = StackError("スタックが空です。")
        ReDim a(1) As Double
        a(1) = vbInf
    End If
    PopDblArray = a

End Function
Function PushIntArray(a() As Integer) As Boolean

'整数型の配列データの格納

    Dim i As Integer
    Dim n As Integer

    n = UBound(a)
    StackCount = StackCount + n + 1
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = n
    For i = 1 To n
        Stack(StackCount - i) = CVar(a(i))
    Next i
    PushIntArray = True

End Function
Function PopIntArray() As Integer()

'整数型の配列データの取出し

    Dim LL As Boolean
    Dim i As Integer
    Dim n As Integer
    Dim a() As Integer

    If (StackCount >= 0) Then
        n = Stack(StackCount)
        If (StackCount >= n) Then
            ReDim a(n) As Integer
            For i = 1 To n
                a(i) = CInt(Stack(StackCount - i))
            Next i
        Else
            LL = StackError("スタックが空です。")
            ReDim a(1) As Integer
            a(1) = vbInf
        End If
        StackCount = StackCount - n - 1
    Else
        LL = StackError("スタックが空です。")
        ReDim a(1) As Integer
        a(1) = vbInf
    End If
    PopIntArray = a

End Function
Function PushVct(a As Vector3D) As Boolean

'３次元ベクトル型データの格納

    StackCount = StackCount + 4
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 3
    Stack(StackCount - 1) = a.x
    Stack(StackCount - 2) = a.y
    Stack(StackCount - 3) = a.z
    PushVct = True

End Function
Function PopVct() As Vector3D

'３次元ベクトル型データの取出し

    Dim LL As Boolean

    If (StackCount >= 3) Then
        If (Stack(StackCount) = 3) Then
            PopVct.x = Stack(StackCount - 1)
            PopVct.y = Stack(StackCount - 2)
            PopVct.z = Stack(StackCount - 3)
            StackCount = StackCount - 4
        Else
            LL = StackError("スタックから３次元ベクトルの取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushQtn(a As Quaternion) As Boolean

'四元数型データの格納

    StackCount = StackCount + 5
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 4
    Stack(StackCount - 1) = a.c
    Stack(StackCount - 2) = a.s.x
    Stack(StackCount - 3) = a.s.y
    Stack(StackCount - 4) = a.s.z
    PushQtn = True

End Function
Function PopQtn() As Quaternion

'四元数型データの取出し

    Dim LL As Boolean

    If (StackCount >= 4) Then
        If (Stack(StackCount) = 4) Then
            PopQtn.c = Stack(StackCount - 1)
            PopQtn.s.x = Stack(StackCount - 2)
            PopQtn.s.y = Stack(StackCount - 3)
            PopQtn.s.z = Stack(StackCount - 4)
            StackCount = StackCount - 5
        Else
            LL = StackError("スタックから四元数の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushMat(a As Matrix3x3) As Boolean

'３Ｘ３マトリクス型データの格納

    StackCount = StackCount + 10
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 9
    Stack(StackCount - 1) = a.x.x
    Stack(StackCount - 2) = a.x.y
    Stack(StackCount - 3) = a.x.z
    Stack(StackCount - 4) = a.y.x
    Stack(StackCount - 5) = a.y.y
    Stack(StackCount - 6) = a.y.z
    Stack(StackCount - 7) = a.z.x
    Stack(StackCount - 8) = a.z.y
    Stack(StackCount - 9) = a.z.z
    PushMat = True

End Function
Function PopMat() As Matrix3x3

'３Ｘ３マトリクス型データの取出し

    Dim LL As Boolean

    If (StackCount >= 9) Then
        If (Stack(StackCount) = 9) Then
            PopMat.x.x = Stack(StackCount - 1)
            PopMat.x.y = Stack(StackCount - 2)
            PopMat.x.z = Stack(StackCount - 3)
            PopMat.y.x = Stack(StackCount - 4)
            PopMat.y.y = Stack(StackCount - 5)
            PopMat.y.z = Stack(StackCount - 6)
            PopMat.z.x = Stack(StackCount - 7)
            PopMat.z.y = Stack(StackCount - 8)
            PopMat.z.z = Stack(StackCount - 9)
            StackCount = StackCount - 10
        Else
            LL = StackError("スタックから３Ｘ３マトリクスの取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushDate(a As yymmdd) As Boolean

'日付型データの格納

    StackCount = StackCount + 4
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 3
    Stack(StackCount - 1) = a.Yr
    Stack(StackCount - 2) = a.Mn
    Stack(StackCount - 3) = a.Dy
    PushDate = True

End Function
Function PopDate() As yymmdd

'日付型データの取出し

    Dim LL As Boolean

    If (StackCount >= 3) Then
        If (Stack(StackCount) = 3) Then
            PopDate.Yr = Stack(StackCount - 1)
            PopDate.Mn = Stack(StackCount - 2)
            PopDate.Dy = Stack(StackCount - 3)
            StackCount = StackCount - 4
        Else
            LL = StackError("スタックから日付の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushTime(a As hhmmss) As Boolean

'時刻型データの格納

    StackCount = StackCount + 4
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 3
    Stack(StackCount - 1) = a.hr
    Stack(StackCount - 2) = a.min
    Stack(StackCount - 3) = a.sec
    PushTime = True

End Function
Function PopTime() As hhmmss

'時刻型データの取出し

    Dim LL As Boolean

    If (StackCount >= 3) Then
        If (Stack(StackCount) = 3) Then
            PopTime.hr = Stack(StackCount - 1)
            PopTime.min = Stack(StackCount - 2)
            PopTime.sec = Stack(StackCount - 3)
            StackCount = StackCount - 4
        Else
            LL = StackError("スタックから時刻の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushGgq(a As GeoGraphicQuantities) As Boolean

'地理関連諸量型データの格納

    StackCount = StackCount + 13
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 13)
    End If
    Stack(StackCount) = 12
    Stack(StackCount - 1) = a.ri    '地心半径（m）
    Stack(StackCount - 2) = a.Vltc  '地心緯度（deg）
    Stack(StackCount - 3) = a.Vlni  '慣性基準からの経度（deg）
    Stack(StackCount - 4) = a.alt   '高度（m）
    Stack(StackCount - 5) = a.Vlat  '測地緯度（deg）
    Stack(StackCount - 6) = a.Vlng  '経度（deg）
    Stack(StackCount - 7) = a.Vi    '慣性速度（m/sec）
    Stack(StackCount - 8) = a.Fpvi  '慣性速度上下角（deg）
    Stack(StackCount - 9) = a.Azvi  '慣性速度方位角（deg）
    Stack(StackCount - 10) = a.Atli '機軸上下角（deg）
    Stack(StackCount - 11) = a.Amis '機軸方位角（deg）
    Stack(StackCount - 12) = a.Rlat '機軸ロール角（バンク角）（deg）
    PushGgq = True

End Function
Function PopGgq() As GeoGraphicQuantities

'地理関連諸量型データの取出し

    Dim LL As Boolean

    If (StackCount >= 12) Then
        If (Stack(StackCount) = 12) Then
            PopGgq.ri = Stack(StackCount - 1)
            PopGgq.Vltc = Stack(StackCount - 2)
            PopGgq.Vlni = Stack(StackCount - 3)
            PopGgq.alt = Stack(StackCount - 4)
            PopGgq.Vlat = Stack(StackCount - 5)
            PopGgq.Vlng = Stack(StackCount - 6)
            PopGgq.Vi = Stack(StackCount - 7)
            PopGgq.Fpvi = Stack(StackCount - 8)
            PopGgq.Azvi = Stack(StackCount - 9)
            PopGgq.Atli = Stack(StackCount - 10)
            PopGgq.Amis = Stack(StackCount - 11)
            PopGgq.Rlat = Stack(StackCount - 12)
            StackCount = StackCount - 13
        Else
            LL = StackError("スタックから地理関連諸量の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushTsv(a As StateVariables) As Boolean

'飛行状態量型データの格納

    StackCount = StackCount + 20
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 20)
    End If
    Stack(StackCount) = 19
    Stack(StackCount - 1) = a.r.x       '地心半径ベクトル（m）
    Stack(StackCount - 2) = a.r.y
    Stack(StackCount - 3) = a.r.z
    Stack(StackCount - 4) = a.v.x       '慣性速度ベクトル（m/sec）
    Stack(StackCount - 5) = a.v.y
    Stack(StackCount - 6) = a.v.z
    Stack(StackCount - 7) = a.qIB.c     '慣性座標系で表した機体座標系の四元数
    Stack(StackCount - 8) = a.qIB.s.x
    Stack(StackCount - 9) = a.qIB.s.y
    Stack(StackCount - 10) = a.qIB.s.z
    Stack(StackCount - 11) = a.Dibm.x.x '慣性座標系で表した機体座標系の方向余弦マトリクス
    Stack(StackCount - 12) = a.Dibm.x.y
    Stack(StackCount - 13) = a.Dibm.x.z
    Stack(StackCount - 14) = a.Dibm.y.x
    Stack(StackCount - 15) = a.Dibm.y.y
    Stack(StackCount - 16) = a.Dibm.y.z
    Stack(StackCount - 17) = a.Dibm.z.x
    Stack(StackCount - 18) = a.Dibm.z.y
    Stack(StackCount - 19) = a.Dibm.z.z
    PushTsv = True

End Function
Function PopTsv() As StateVariables

'飛行状態量型データの取出し

    Dim LL As Boolean

    If (StackCount >= 19) Then
        If (Stack(StackCount) = 19) Then
            PopTsv.r.x = Stack(StackCount - 1)
            PopTsv.r.y = Stack(StackCount - 2)
            PopTsv.r.z = Stack(StackCount - 3)
            PopTsv.v.x = Stack(StackCount - 4)
            PopTsv.v.y = Stack(StackCount - 5)
            PopTsv.v.z = Stack(StackCount - 6)
            PopTsv.qIB.c = Stack(StackCount - 7)
            PopTsv.qIB.s.x = Stack(StackCount - 8)
            PopTsv.qIB.s.y = Stack(StackCount - 9)
            PopTsv.qIB.s.z = Stack(StackCount - 10)
            PopTsv.Dibm.x.x = Stack(StackCount - 11)
            PopTsv.Dibm.x.y = Stack(StackCount - 12)
            PopTsv.Dibm.x.z = Stack(StackCount - 13)
            PopTsv.Dibm.y.x = Stack(StackCount - 14)
            PopTsv.Dibm.y.y = Stack(StackCount - 15)
            PopTsv.Dibm.y.z = Stack(StackCount - 16)
            PopTsv.Dibm.z.x = Stack(StackCount - 17)
            PopTsv.Dibm.z.y = Stack(StackCount - 18)
            PopTsv.Dibm.z.z = Stack(StackCount - 19)
            StackCount = StackCount - 20
        Else
            LL = StackError("スタックから飛行状態量の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushSite(a As SiteLocation) As Boolean

'地上局位置型データの格納

    StackCount = StackCount + 8
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 7
    Stack(StackCount - 1) = a.alt   '高度（m）
    Stack(StackCount - 2) = a.Ltg   '測地緯度（deg）
    Stack(StackCount - 3) = a.lng   '経度（deg）
    Stack(StackCount - 4) = a.Azl   '局設置方位角（deg）
    Stack(StackCount - 5) = a.lat   '天文緯度（deg）
    Stack(StackCount - 6) = a.Gsp   'ジオイドのずれ（m）
    Stack(StackCount - 7) = a.Def   '東西方向の鉛直からの傾き（deg）
    PushSite = True

End Function
Function PopSite() As SiteLocation

'地上局位置型データの取出し

    Dim LL As Boolean

    If (StackCount >= 7) Then
        If (Stack(StackCount) = 7) Then
            PopSite.alt = Stack(StackCount - 1)
            PopSite.Ltg = Stack(StackCount - 2)
            PopSite.lng = Stack(StackCount - 3)
            PopSite.Azl = Stack(StackCount - 4)
            PopSite.lat = Stack(StackCount - 5)
            PopSite.Gsp = Stack(StackCount - 6)
            PopSite.Def = Stack(StackCount - 7)
            StackCount = StackCount - 8
        Else
            LL = StackError("スタックから地上局位置データの取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushView(a As ViewQuantities) As Boolean

'視野情報型データの格納

    StackCount = StackCount + 9
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 10)
    End If
    Stack(StackCount) = 8
    Stack(StackCount - 1) = a.r.x   '地心半径ベクトル（m）
    Stack(StackCount - 2) = a.r.y
    Stack(StackCount - 3) = a.r.z
    Stack(StackCount - 4) = a.Rg    '直距離（m）
    Stack(StackCount - 5) = a.Az    '方位角（deg）
    Stack(StackCount - 6) = a.El    '上下角（deg）
    Stack(StackCount - 7) = a.Tla   'トータルルックアングル（deg）
    Stack(StackCount - 8) = a.Rla   'ロールルックアングル（deg）
    PushView = True

End Function
Function PopView() As ViewQuantities

'視野情報型データの取出し

    Dim LL As Boolean

    If (StackCount >= 8) Then
        If (Stack(StackCount) = 8) Then
            PopView.r.x = Stack(StackCount - 1)
            PopView.r.y = Stack(StackCount - 2)
            PopView.r.z = Stack(StackCount - 3)
            PopView.Rg = Stack(StackCount - 4)
            PopView.Az = Stack(StackCount - 5)
            PopView.El = Stack(StackCount - 6)
            PopView.Tla = Stack(StackCount - 7)
            PopView.Rla = Stack(StackCount - 8)
            StackCount = StackCount - 9
        Else
            LL = StackError("スタックから地上局からの視野情報の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function PushOrb(a As OrbitalElements) As Boolean

'軌道要素型データの格納

    StackCount = StackCount + 20
    If (StackCount >= UBound(Stack)) Then
        ReDim Preserve Stack(StackCount + 20)
    End If
    Stack(StackCount) = 19
    Stack(StackCount - 1) = a.a     '軌道長半径（m）
    Stack(StackCount - 2) = a.ecc   '離心率
    Stack(StackCount - 3) = a.ainc  '軌道傾斜角（deg）
    Stack(StackCount - 4) = a.asnd  '昇降点経度（deg）
    Stack(StackCount - 5) = a.argp  '近地点引数（deg）
    Stack(StackCount - 6) = a.argl  '緯度引数（deg）
    Stack(StackCount - 7) = a.apf   '遠地点高度（m）
    Stack(StackCount - 8) = a.prf   '近地点高度（m）
    Stack(StackCount - 9) = a.Raan  '昇降点赤経（deg）
    Stack(StackCount - 10) = a.ant  '真近点離角（deg）
    Stack(StackCount - 11) = a.ane  '離心近点離角（deg）
    Stack(StackCount - 12) = a.anm  '平均近点離角（deg）
    Stack(StackCount - 13) = a.apg  '遠地点半径（m）
    Stack(StackCount - 14) = a.prg  '近地点半径（m）
    Stack(StackCount - 15) = a.vapf '遠地点速度（m/s）
    Stack(StackCount - 16) = a.vprf '近地点速度（m/s）
    Stack(StackCount - 17) = a.envv '軌道エネルギー（m^2/s^2）
    Stack(StackCount - 18) = a.perd '周期（s）
    Stack(StackCount - 19) = a.p    '半通径（m）
    PushOrb = True

End Function
Function PopOrb() As OrbitalElements

'軌道要素型データの取出し

    Dim LL As Boolean

    If (StackCount >= 19) Then
        If (Stack(StackCount) = 19) Then
            PopOrb.a = Stack(StackCount - 1)
            PopOrb.ecc = Stack(StackCount - 2)
            PopOrb.ainc = Stack(StackCount - 3)
            PopOrb.asnd = Stack(StackCount - 4)
            PopOrb.argp = Stack(StackCount - 5)
            PopOrb.argl = Stack(StackCount - 6)
            PopOrb.apf = Stack(StackCount - 7)
            PopOrb.prf = Stack(StackCount - 8)
            PopOrb.Raan = Stack(StackCount - 9)
            PopOrb.ant = Stack(StackCount - 10)
            PopOrb.ane = Stack(StackCount - 11)
            PopOrb.anm = Stack(StackCount - 12)
            PopOrb.apg = Stack(StackCount - 13)
            PopOrb.prg = Stack(StackCount - 14)
            PopOrb.vapf = Stack(StackCount - 15)
            PopOrb.vprf = Stack(StackCount - 16)
            PopOrb.envv = Stack(StackCount - 17)
            PopOrb.perd = Stack(StackCount - 18)
            PopOrb.p = Stack(StackCount - 19)
            StackCount = StackCount - 20
        Else
            LL = StackError("スタックから軌道要素の取得に失敗しました。")
            StackCount = StackCount - Stack(StackCount) - 1
        End If
    Else
        LL = StackError("スタックが空です。")
    End If

End Function
Function StackError(c As String) As Boolean

'実行時スタックエラーの処理

    Dim LL As Boolean
    Dim i As Integer
    Dim msg As String
    Dim del As String

    msg = c & "／／ スタックサイズ＝" & CStr(Stack(StackCount)) & "、値"
    del = "＝"
    For i = 1 To Stack(StackCount)
        msg = msg & del & CStr(Stack(StackCount - i))
        del = "、"
    Next i
    LL = ExecutionError(msg)
    ErrLoc = InstLoc

End Function
Function ExecutionError(c As String) As Boolean

'実行時エラーの処理

    Dim LL As Boolean
    Dim i As Integer
    Dim k As Integer
    Dim iI As Integer
    Dim iL As Integer
    Dim msg As String
    Dim del As String

    msg = CStr(InstLoc) & "番地：" & c & vbLf & "エラー発生番地前後の命令コード" & vbLf
    iI = InstLoc - 5
    If (iI < 0) Then iI = 0
    iL = InstLoc + 5
    If (iL > InstCount) Then iL = InstCount
    For i = iI To iL
        k = Inst(i)
        msg = msg & "番地：" & Right(Space(3) & CStr(i), 4) _
                  & "、　字句番号：" & Right(Space(3) & CStr(TokenStack(k).SeqNo), 4) _
                  & "、　型：" & Right(Space(3) & CStr(TokenStack(k).Type), 4) _
                  & "、　値：" & Right(Space(8) & CStr(TokenStack(k).Value), 9) _
                  & "、　文字列：" & Space(2) & TokenStack(k).String & vbLf
    Next i
    LL = ErrorMessage(msg)

End Function
Function ErrorMessage(msg As String)

'エラーメッセージの設定処理

    ActiveSheet.Range(CallerAddress).Comment.Text ActiveSheet.Range(CallerAddress).Comment.Text & msg & vbLf

End Function
