Webで動くVBAチュートリアルを作りたい その6

その5の続き。

変数を評価できるようにしたいので、メモリの内容を変数で置き換えるプロシージャを作成。これは、その5で作成したM2_Subモジュールに作成。

まずは予約語の評価を回避するために、General領域にDictionary型の変数を準備。

※これは参照設定でMicrosoft Scripting Runtimeが必要

Public Variables As Scripting.Dictionary
Public Keywords As Scripting.Dictionary
Public VariableTypes As Scripting.Dictionary
Public VBAFunctions As Scripting.Dictionary

そして以下が予約後を登録するコード。予約語の羅列がかなり見苦しいが、外部ファイルにするとファイルの管理が面倒なのでとりあえずVBAの段階ではコードに直書きした。

また、例によって変数宣言していないが、ある程度組み上がってからOptionExplicitを付けて直すスタイルなので気にしないで欲しい。

    Sub GlobalDefinition()
    '変数
    Set Variables = New Scripting.Dictionary
    
    '以下、各種予約語の登録
    Set Keywords = New Scripting.Dictionary
    Set VariableTypes = New Scripting.Dictionary
    Set VBAFunctions = New Scripting.Dictionary
    
    For Each x In Split("Append Base Binary ByRef ByVal Call Case Compare Date Declare Dim Do DoEvents Each Else Empty End Error Exit Explicit False For Friend Function Get GoSub GoTo If Input Is Len Let Lock Loop Me Mid New Next Nothing Null Open Option Optional Output ParamArray Print Private Property Public Random Read Resume Seek Select Set Shared Static Step Sub Then Time To True With WithEvents Write", " ")
        Call Keywords.Add(x, x)
    Next
    For Each x In Split("String Integer Long Single Double")
        Call VariableTypes.Add(x, x)
    Next
    For Each x In Split("Abs Array Asc AscB AscW Atn CallByName CBool CByte CCur CDate CDbl CDec Choose Chr ChrB ChrW CInt CLng Cos CreateObject CSng CStr CurDir CVar CVDate CVErr Date DateAdd DateDiff DatePart DateSerial DateValue Day DDB Dir DoEvents EnViron EOF Error Exp FileAttr FileDateTime FileLen Filter Fix Format FormatCurrency FormatDateTime FormatNumber FormatPercent FreeFile FV GetAllSettings GetAttr GetObject GetSetting Hex Hour IIf IMEStatus Input InputB InputBox InStr InstrB InStrRev Int IPmt IRR IsArray IsDate IsEmpty IsError IsMissing IsNull IsNumeric IsObject Join LBound LCase Left LeftB Len LenB LoadPicture Loc LOF Log LTrim MacID MacScript Mid MidB Minute MIRR Month MonthName MsgBox Now NPer NPV Oct Partition Pmt PPmt PV QBColor Rate Replace RGB Right RightB Rnd Round RTrim Second Seek Sgn Shell Sin SLN Space Spc Split Sqr Str StrComp StrConv String StrReverse Switch SYD Tab Tan Time Timer TimeSerial TimeValue Trim TypeName UBound UCase Val VarType WeekDay WeekdayName Year")
        Call VBAFunctions.Add(x, x)
    Next
End Sub

 さらに続けて、変数を評価するプロシージャと、画面表示のためのプロシージャ

'変数を評価するプロシージャ
Sub EvalVariable(ByRef Memory() As String)
    If UBound(Memory) < 1 Then Exit Sub
    For i = 1 To UBound(Memory)
        If Memory(i) Like "*[a-z]*" Then
        
            'キーワードでも型でも関数でも無ければ、変数とみなす。
            If Not Keywords.Exists(Memory(i)) _
              And Not VariableTypes.Exists(Memory(i)) _
              And Not VBAFunctions.Exists(Memory(i)) Then
                
                'あればメモリをその値に書き換え、無ければ登録してEmptyを入れる
                If Variables.Exists(Memory(i)) Then
                    Memory(i) = Variables.Item(Memory(i))
                Else
                    Call Variables.Add(Memory(i), Empty)
                    Memory(i) = ""
                End If
            End If
        End If
    Next i
End Sub

'デバッグプリント用
Sub Printer(ByRef Memory() As String)
    For i = 0 To UBound(Memory)
        Debug.Print "memory(" & i & ")←[" & Memory(i) & "]"
    Next i
End Sub

最後に、それらを利用するテストコード。これはM1_Mainモジュールに書いた。

※その5で作成したM3_Baseモジュールも使用する。

Sub Tester()
    Call GlobalDefinition
    
    '変数への代入。まだ代入命令の解釈が出来ないので、直接VBA命令で入れる。
    Call Variables.Add("Name", """Thom""")
    '定数機能もないので、とりあえず変数として入れておく。
    Call Variables.Add("vbNewLine", vbNewLine)
    
    Dim st As String
    
    st = "MsgBox ""こんにちは"""""" & Name & """"""さん。" & _
        """ & vbNewLine & ""お元気ですか？"""
        
    If Trim(st) <> "" Then
        Dim Memory() As String
        Memory = TextToElemArray(st)
        Call EvalVariable(Memory)
        Call Printer(Memory)
    End If
    
End Sub

ここまでくれば、あとはメモリの内容をくっつけるだけ。ただし、途中で計算式とかが入る可能性があるので、次回はスタックを実装しようと思う。