タグ: Excel

ExcelのVBAで作成したマクロから OpenAI の API が使えればいろいろと AI の活用範囲が広がりそうだったので、試してみることにしました。

なお、VBAの作成にあたっては、わちょんさんの以下の Youtubeを参考にさせていただきました。大変ありがとうございました。

ちなみに、この動画自体は３年前のもので、概要欄に書かれているコードをそのまま実行させても今の OpenAIでは動作しないようでしたので、「１．VBAの修正」の通り少し修正させていただきました。

１．VBAの修正

わちょんさんの概要欄に記載されているコードからの主な修正点は”★”の部分です。

Option Explicit
'★Chat Completions APIを使う場合のURLを変更
Const API_URL As String = "https://api.openai.com/v1/chat/completions"

Sub ApplyAddressCorrection()
    Dim apiKey As String
    Dim text As String
    Dim response As String
    Dim responseArray() As String
    Dim ws As Worksheet
    Dim i As Long
    
    Set ws = ActiveSheet
    ws.Range("B5").CurrentRegion.ClearContents

    '★Windowsの環境変数にAPIキーを保存し、VBAから読み込む方法に変更   
    apiKey = Environ("OPENAI_API_KEY")

    If apiKey = "" Then
        MsgBox "OpenAI APIキーが設定されていません。", vbCritical
        Exit Sub
    End If
    
    '★現行モデル"gpt-5-nano"の利用に変更
    '★temperature = ws.Range("D3").Valueを削除
    '★"max_tokens": 2000から"max_completion_tokens": 2000に変更
    text = ws.Range("B2").Value & ws.Range("B3").Value
    text = "{""model"": ""gpt-5-nano"", ""max_completion_tokens"": 2000" & ", ""messages"": [{""role"": ""user"", ""content"": """ & text & """}]}"
    response = sendAPIRequest(API_URL, text, apiKey)

    '★responseの中身を確認
    Debug.Print response
    
    '★extractContentの処理を２回→１回に変更し効率化
    response = extractContent(response)
    ws.Range("B5").Value = response
 
    response = Replace(response, "\n", vbLf)
    If ws.Range("D5").Value = "する" Then response = Replace(response, "。", "。" & vbLf)
    responseArray = Split(response, vbLf)
    For i = 0 To UBound(responseArray)
        ws.Range("B" & 5 + i).Value = responseArray(i)
    Next i
End Sub

Function sendAPIRequest(url As String, text As String, apiKey As String) As String
    Dim request As Object
    Set request = CreateObject("MSXML2.XMLHTTP")
    request.Open "POST", url, False
    request.setRequestHeader "Content-Type", "application/json"
    request.setRequestHeader "Authorization", "Bearer " & apiKey
    request.send text
    sendAPIRequest = request.responseText
End Function

Function extractContent(response As String) As String
    Dim startPos As Integer
    Dim endPos As Integer
    
    '★JSONの解析方法を変更
    startPos = InStr(1, response, """content"": """)

    If startPos = 0 Then
        extractContent = response
        Exit Function
    End If

    startPos = startPos + 12

    endPos = InStr(startPos, response, """")

    If endPos = 0 Then
        extractContent = response
        Exit Function
    End If

    extractContent = Mid(response, startPos, endPos - startPos)


End Function

２．Windowsの環境変数にAPIキーを保存

「１．VBAの修正」の中で記載の通り、Windowsの環境変数にAPIキーを保存し、VBAから読み込む方法にVBAを変更していますので、Windows11にて以下の操作を実行しています。

１．スタートボタンをクリック
２．「環境変数」と検索
３．「システム環境変数の編集」を開く
４．「システムのプロパティ」が開いたら、「環境変数」をクリック
５．「ユーザー環境変数」のところで 「新規」をクリック

上記の５．まで実施すると以下のウィンドウが表示されるので、
・変数名：OPENAI_API_KEY
・変数値：OpenAIで取得したAPIキー（sk-… ）
を入力し、「OK」ボタンを押します。

この後、コマンドプロンプトを開いて下記のように入力し、APIキーが表示されれば登録成功です。（set コマンドで確認してもOK）

echo %OPENAI_API_KEY%

３．VBAの実行

ExcelにてセルのB2 および B3に OpenAIに質問したい事項を記入後、[ALT]＋[F11]にてVBAの編集画面を起動し実行すれば、B5に OpenAIからの回答が出力されました。