Pythonを実行するワークシート関数をVBAで再現する

:::note warn
以下は訳あって削除済みの過去記事の転載です（published at 2023-08-23 21:16）。
:::

---

https://techcommunity.microsoft.com/t5/excel-blog/announcing-python-in-excel-combining-the-power-of-python-and-the/ba-p/3893439

こんな話を見かけたのでVBAで再現する回です。

## 実装

https://twitter.com/U_1F992/status/1694321103873933632

標準入力に1行書いて出力を読むだけ、かんたんですね！他の言語でもできると思います。久しぶりにVBAを書いたので、ベストプラクティスからは外れているかもしれません。

```vb
Option Explicit

Private Function EndsWith(strInput As String, strSuffix As String) As Boolean
    Dim lInput As Long
    lInput = Len(strInput)
    Dim lSuffix As Long
    lSuffix = Len(strSuffix)

    If lSuffix > lInput Then
        EndsWith = False
    Else
        EndsWith = (Right(strInput, lSuffix) = strSuffix)
    End If
End Function

Private Function RemoveLastLine(strInput As String) As String
    Dim i As Long
    Dim ret As String
    ret = ""
    Dim arrLines As Variant
    arrLines = Split(strInput, vbLf)

    For i = LBound(arrLines) To UBound(arrLines) - 1
        ret = ret & arrLines(i) & vbLf
    Next i
    ret = Left(ret, Len(ret) - Len(vbLf))
    
    RemoveLastLine = ret
End Function

Private Sub ReadUntilNextPrompt(objInterpreter As Object, ByRef strOutput As String)
    Dim PROMPT_LINE_START As String
    PROMPT_LINE_START = ">>> "
    
    Dim PROMPT_LINE_CONTINUE As String
    PROMPT_LINE_CONTINUE = "... "

    Do While objInterpreter.Status = 0 And Not (EndsWith(strOutput, PROMPT_LINE_START) Or EndsWith(strOutput, PROMPT_LINE_CONTINUE))
        strOutput = strOutput & objInterpreter.StdOut.Read(1)
    Loop
End Sub

Private Function CreateInterpreter(objWshShell As Object, ByRef strOutput As String) As Object
    ''' -i：スクリプト実行後に対話モードに入るオプション。なぜか含めないと動かない
    ''' cmd /c ~ 2>&1：">>>"など標準エラーに出力される内容を標準出力にリダイレクトする
    Dim PYTHON_EXECUTABLE  As String
    PYTHON_EXECUTABLE = "cmd /c py.exe -i 2>&1"

    Dim ret As Object
    Set ret = objWshShell.Exec(PYTHON_EXECUTABLE)

    ReadUntilNextPrompt ret, strOutput

    Set CreateInterpreter = ret
End Function

Private Sub ExecuteScript(objInterpreter As Object, strScript As String, ByRef strOutput As String)
    Dim strScriptWithNewLine As String
    strScriptWithNewLine = strScript & vbLf

    objInterpreter.StdIn.Write (strScriptWithNewLine)
    strOutput = strOutput & strScriptWithNewLine

    ReadUntilNextPrompt objInterpreter, strOutput
End Sub

Private Sub TerminateInterpreter(objInterpreter As Object)
    If objInterpreter.Status = 0 Then
        ExecuteScript objInterpreter, "exit()", ""
    End If
    objInterpreter.Terminate
    Do While objInterpreter.Status = 0
        DoEvents
    Loop
End Sub

Function PY(strScript As String) As String
    strScript = Replace(strScript, vbCrLf, vbLf)

    Dim i As Long
    Dim strOutput As String
    strOutput = ""
    Dim objWshShell As Object
    Set objWshShell = CreateObject("WScript.Shell")
    Dim objInterpreter As Object
    Set objInterpreter = CreateInterpreter(objWshShell, strOutput)

    Dim arrScripts As Variant
    arrScripts = Split(strScript, vbLf)
    For i = LBound(arrScripts) To UBound(arrScripts)
        ExecuteScript objInterpreter, CStr(arrScripts(i)), strOutput
    Next i
    strOutput = Replace(strOutput, vbCrLf, vbLf)
    strOutput = RemoveLastLine(strOutput) ' 最後の行は必ず">>> "

    TerminateInterpreter objInterpreter
    Set objInterpreter = Nothing
    Set objWshShell = Nothing
    
    PY = strOutput
End Function
```

## はまりどころ

`Exec`メソッドの戻り値である`WshScriptExec`オブジェクトでは子プロセスの標準入出力に触ることができますが、標準出力が空のときに`Read`／`ReadLine`／`ReadAll`メソッドを実行するとブロックされます。しかし、ブロックせずに`Read`できるかどうかを判別するよい手段が見当たりません。標準出力の末尾にいることを知る手段がないうえ、入力後にあるぶんだけ読み取るとブロックされて次の入力ができなくなるため、対話モードのような用途では使いづらくなっています[^1]。

今回は、入力の開始を表すプロンプト`>>> `と、入力の継続を表す`... `までを読み込むと決めることで、この問題を回避しています。いつまでも`>>> `が表示されないようなスクリプトを実行すると、Excelに帰ってこれなくなるということです。

[^1]: 参考：https://elsur.jpn.org/mt/2009/06/001072.html