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の完成です。
この記事が気に入ったらサポートをしてみませんか?