ExcelからChat-GPTを利用する

仕組み

curlでもapiを利用することができるので、それをexcelのvbaへ組み込もうと思います。ただし、やることはOpenAIもAzureOpenAIも変わらないのですが、OpenAIで利用できるのはAPIの料金を支払っている場合だけです。払ってない場合は、Error429:"You exceeded your current quota, please check your plan and billing details."こんなエラーになります。また、ChatGPT for Excelなどのアドインの場合はこのほかにもアドインの有料プランが必要な感じでした。（有償でやってないのでわかりません）

ソースコード

まず、APIの設定をしておくシートを用意して、変更したいパラメーターをrange名を付けながら設定しておくと、取り出しが簡単です。

Public Function ChatGpt(prompt As Range, assistant As Range, user As Range)

    ChatGpt = Completion(prompt.Value, assistant.Value, user.Value)

End Function

Function GetApiKey()
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("API")
    GetApiKey = ws.Range("apikey").Value

End Function

Function GetApiEngine()
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("API")
    GetApiEngine = ws.Range("apiengine").Value

End Function

Function GetApiVersion()
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("API")
    GetApiVersion = ws.Range("apiversion").Value

End Function

Function GetMaxTokens()
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("API")
    GetMaxTokens = ws.Range("max_tokens").Value

End Function

Function MakeUrl(apikey, apiengine, apiversion)
    
    MakeUrl = baseurl + apiengine + "/chat/completions?api-version=" + apiversion
    
End Function

Function Completion(prompt As String, assitant As String, user As String)

    Dim apikey As String
    Dim apiengine As String
    Dim apiversion As String
    Dim max_tokens As String
    Dim request As Object

    apikey = GetApiKey()
    apiengine = GetApiEngine()
    apiversion = GetApiVersion()
    max_tokens = GetMaxTokens()
    
    Dim url As String
    url = MakeUrl(apikey, apiengine, apiversion)

    Set request = CreateObject("MSXML2.XMLHTTP")
    
    Dim jsondata As String
    Dim xprompt As String, xuser As String, xassistant As String
        
    xprompt = Replace(prompt, vbLf, "\n")
    xprompt = Replace(xprompt, vbCr, "\n")
    xprompt = Replace(xprompt, vbCrLf, "\n")
    
    xuser = Replace(user, vbLf, "\n")
    xuser = Replace(xuser, vbCr, "\n")
    xuser = Replace(xuser, vbCrLf, "\n")
    
    xassistant = Replace(assistant, vbLf, "\n")
    xassistant = Replace(xassistant, vbCr, "\n")
    xassistant = Replace(xassistant, vbCrLf, "\n")
    
    jsondata = "{""messages"":[" + vbCrLf _
        + "{""role"":""system""," + vbCrLf _
        + """content"":""" + xprompt + """}," + vbCrLf _
        + "{""role"":""user""," + vbCrLf _
        + """content"":""" + xuser + """}," + vbCrLf _
        + "{""role"":""assistant""," + vbCrLf _
        + """content"":""" + xassistant + """}" + vbCrLf _
        + "]," + vbCrLf _
        + """max_tokens"":" + max_tokens + "," + vbCrLf _
        + """temperature"":0.7," + vbCrLf _
        + """frequency_penalty"":0," + vbCrLf _
        + """presence_penalty"":0," + vbCrLf _
        + """top_p"":0.95," + vbCrLf _
        + """stop"":""null""" + vbCrLf _
        + "}"
   
    request.Open "POST", url, False
    request.setRequestHeader "Content-Type", "application/json"
    request.setRequestHeader "api-key", apikey
    request.send jsondata

    Dim responseText As String
    responseText = request.responseText

    Dim temp As String
    
    temp = Right(responseText, Len(responseText) - InStr(responseText, "choice"))
    temp = Left(temp, InStr(temp, "content_filter_results") - 5)
    temp = Right(temp, Len(temp) - InStr(temp, "content") - 9)
    
    Completion = temp

End Function

定数などを省略していますが、動かせばエラーになるので、見つけることは容易かと。あと、私の実力不足なのでしょうか、改行込みでjsonを投げつけられないので、"\n"に変換してあります。utf-8の場合、vbLFが改行コードなんですね。
あとはこれをエクセルの関数として、ChatGPT(prompt(system),assistant,user)のように関数で呼び出すだけで、結構重いは重いのですが、ExcelxChatGPTの完成です。