Excel VBAからChatGPTを呼び出す🪄

ChatGPTがおしゃべりだけではなく調べ物などあらゆるタスクにおいてパワフルなアシスタントとして活躍してくれることについては、ここではもう説明するまでもないでしょう。

そんなChatGPTをブラウザだけではなくExcel VBAから直接使えるようにするというのがこの記事の内容です。この技術を応用すると、こんなことができるようになります。

製品カテゴリー（この動画では、商用データベースソフト）を入力するだけで競合製品の一覧と製品評価軸を自動設定、そして評価コメントまで自動で入力してくれました。あとは人間が添削すれば良いのでとても楽ちんです。

それでは、作り方をみていきましょう。

ChatGPTのAPIキーを取得

はじめに、ブラウザからではなくネットワーク経由でプログラムに組み込むためのAPIを利用できるようにします。
利用申し込みは以下のOpenAI社のサイトから行っていただき、最終的にAPI Keyを取得することができたらOKです。

必要なライブラリーを入手

APIとの通信はJSONというデータ形式で行いますので、これをExcel VBAから利用できるようにします。ちょうどぴったりのVBA-JSONというライブラリーがありますので、これをダウンロードしてJsonConverter.basをVBAプロジェクトに追加しておいてください。

ChatGPTの呼び出し関数を作成

まず、ChatGPTのAPI仕様をみてみましょう。

いろいろ書いていますが、ざっくり言うといかのような仕様になっています。

1. POSTメソッドで呼び出すこと
2. API KeyをAuthorizationヘッダーにつけて渡すこと
3. 各種パラメーターはJSON形式で渡すこと
4. 会話全体にかかる条件（プロンプトと呼ばれるもの）とユーザーの入力は、JSONのなかのmessages項目でそれぞれ辞書型で渡すこと
5. 英語は1単語、日本語は1文字を1トークンとし、max_tokensで要求・応答のトークンの合算値を指定できること（課金もトークン数に応じます）

まずは全体に関わる設定と、messagesを組み立てるための関数を作っていきます。

' 全体に関わる設定
Option Explicit
' API呼び出しで使うSleep
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' API呼び出しで使うAPI Key
Public ApiKey As String

' Create system and user messages
Public Function CreateMessages(systemContent As String, userContent As String) As Dictionary()
    Dim messages(1) As Dictionary
    
    Set messages(0) = New Dictionary
    messages(0).Add "role", "system"
    messages(0).Add "content", systemContent
    Set messages(1) = New Dictionary
    messages(1).Add "role", "user"
    messages(1).Add "content", userContent
    
    CreateMessages = messages
End Function

特に解説も不要かと思いますので、次に行きましょう。今度はAPIを呼び出す部分を作ります。

' Call OpenAI Chat.Completion API
Public Function GetCompletion(messages As Variant, _
    Optional model As String = "gpt-3.5-turbo", _
    Optional temperature As Single = 1, _
    Optional topP As Single = 1, _
    Optional n As Integer = 1, _
    Optional stopWords As Variant, _
    Optional maxTokens As Integer = 16, _
    Optional presencePenalty As Single = 0, _
    Optional frequencyPenalty As Single = 0, _
    Optional logitBias As Variant, _
    Optional user As String, _
    Optional asText As Boolean = True _
    ) As Variant
    
    ' 引数をAPIパラメーターにセット
    Dim data As New Dictionary
    data.Add "messages", messages
    data.Add "model", model
    data.Add "temperature", temperature
    data.Add "top_p", topP
    data.Add "n", n
    If Not IsMissing(stopWords) Then
        data.Add "stop", stopWords
    End If
    data.Add "max_tokens", maxTokens
    data.Add "presence_penalty", presencePenalty
    data.Add "frequency_penalty", frequencyPenalty
    If Not IsMissing(logitBias) Then
        data.Add "logit_bias", logitBias
    End If
    If user <> "" Then
        data.Add "user", user
    End If
    
    ' APIの呼び出し
    Dim client As Object
    Set client = CreateObject("MSXML2.ServerXMLHTTP")
    client.setTimeouts 30000, 30000, 30000, 60000
    client.Open "POST", "https://api.openai.com/v1/chat/completions"
    client.setRequestHeader "Content-Type", "application/json"
    client.setRequestHeader "Authorization", "Bearer " & ApiKey
    client.send JsonConverter.ConvertToJson(data)

    ' レスポンスの待機
    Do While client.readyState < 4
        Sleep 1
        DoEvents
    Loop

    ' レスポンスデータの取得
    Dim completion As Dictionary
    Set completion = JsonConverter.ParseJson(client.responseText)
    
    ' エラーの場合は通知
    If completion.Exists("error") Then
        Err.Raise 9001, Description:=completion("error")("message")
    End If

    ' 値の返却（デフォルトでは応答本文のみを返す）
    If asText Then
        GetCompletion = completion("choices")(1)("message")("content")
    Else
        Set GetCompletion = completion
    End If
End Function

こちらもほとんどがFunctionの引数→APIのパラメーターへの詰め替えなので、あまり解説するところがありません。流れはコメントを見てもらえばわかると思います。

動作確認

さて、最後にこれを呼び出してみましょう。APIキーのセットを忘れずに。

Sub Main()
    ChatGPT.ApiKey = "YOUR_API_KEY"

    Dim messages() As Dictionary
    messages = ChatGPT.CreateMessages("あなたは生物学者です。", "ウナギとアナゴの違いを教えてください。")
    
    Dim completion As String
    completion = ChatGPT.GetCompletion(messages, maxTokens:=1000, temperature:=0.5)
    
    Debug.Print completion
End Sub

ウナギとアナゴの違いが、イミディエイトウィンドウに表示されたら成功です。

さらに便利に使えるように

さて、これでめでたしめでたしですが、人によってはちょっと呼び出しの手続きが面倒と思われるかもしれません。なので、簡易的に使える呼び出し関数も作るとさらに気軽に使えるようになります。

' Simple interface for GetCompletion
Public Function Chat(userMessage As String, Optional promptMessage As String, Optional maxTokens As Integer = 1000) As String
    Dim messages() As Dictionary

    If promptMessage <> "" Then
        messages = CreateMessages(promptMessage, userMessage)
    Else
        ReDim messages(0)
        Set messages(0) = New Dictionary
        messages(0).Add "role", "user"
        messages(0).Add "content", userMessage
    End If
    
    Chat = GetCompletion(messages, maxTokens:=maxTokens)
End Function

こんな感じで、API Keyをセットしてユーザー入力さえ渡せば動くようにしてみました。temperature（回答のランダムさ。0~2で大きいほどランダム）とか、お好みやマクロの用途に応じてここで設定しちゃってもいいかもしれませんね。利用方法を具体的にコードにすると以下の通りです。

Sub Main2()
    ChatGPT.ApiKey = "YOUR_API_KEY"
    Debug.Print ChatGPT.Chat("ウナギとアナゴの違いを教えてください。")
End Sub

はい、とても簡単になりました✨

chatgpt-vbaのご案内

上記のようなコードや依存ライブラリーをパッケージにした「chatgpt-vba」を公開しました！インポートしたらすぐに動くと思いますので、ご自由にご利用ください。

役に立つと思ってくれた方はぜひGitHubでスター⭐️をお願いします！

それでは、たのしいChatGPT × Excel VBAライフを！